(git:31876b5)
Loading...
Searching...
No Matches
rt_propagation_output.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Routine for the real time propagation output.
10!> \author Florian Schiffmann (02.09)
11! **************************************************************************************************
12
15 USE cell_types, ONLY: cell_type
18 USE cp_dbcsr_api, ONLY: &
19 dbcsr_add, dbcsr_binary_write, dbcsr_convert_offsets_to_sizes, dbcsr_copy, dbcsr_create, &
24 dbcsr_type_antisymmetric, dbcsr_type_no_symmetry
36 USE cp_fm_types, ONLY: cp_fm_create,&
47 cp_p_file,&
53 USE efield_utils, ONLY: make_field
55 USE input_constants, ONLY: ehrenfest,&
60 USE kahan_sum, ONLY: accurate_sum
61 USE kinds, ONLY: default_path_length,&
62 dp
63 USE machine, ONLY: m_flush
64 USE mathconstants, ONLY: twopi
70 USE physcon, ONLY: evolt,&
72 USE pw_env_types, ONLY: pw_env_get,&
74 USE pw_methods, ONLY: pw_zero
76 USE pw_types, ONLY: pw_c1d_gs_type,&
89 USE qs_rho_types, ONLY: qs_rho_get,&
100 USE rt_propagation_types, ONLY: get_rtp,&
104#include "../base/base_uses.f90"
105
106 IMPLICIT NONE
107
108 PRIVATE
109
110 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rt_propagation_output'
111
112 PUBLIC :: rt_prop_output, &
118 print_ft, &
120
121 INTEGER, PARAMETER, PUBLIC :: rt_file_comp_both = 0, &
122 rt_file_comp_real = 1, &
124
125CONTAINS
126
127! **************************************************************************************************
128!> \brief ...
129!> \param qs_env ...
130!> \param run_type ...
131!> \param delta_iter ...
132!> \param used_time ...
133! **************************************************************************************************
134 SUBROUTINE rt_prop_output(qs_env, run_type, delta_iter, used_time)
135 TYPE(qs_environment_type), POINTER :: qs_env
136 INTEGER, INTENT(in) :: run_type
137 REAL(dp), INTENT(in), OPTIONAL :: delta_iter, used_time
138
139 INTEGER :: i, n_electrons, n_proj, natom, nspin, &
140 output_unit, spin, unit_nr
141 INTEGER, ALLOCATABLE, DIMENSION(:) :: first_sgf, last_sgf
142 INTEGER, DIMENSION(2) :: nelectron_spin
143 INTEGER, DIMENSION(:), POINTER :: row_blk_sizes
144 LOGICAL :: new_file
145 REAL(dp) :: orthonormality, strace, tot_rho_r, trace
146 REAL(kind=dp), DIMENSION(3) :: field, reference_point
147 REAL(kind=dp), DIMENSION(:), POINTER :: qs_tot_rho_r
148 REAL(kind=dp), DIMENSION(:, :), POINTER :: j_int
149 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
150 TYPE(cp_fm_type), DIMENSION(:), POINTER :: mos_new
151 TYPE(cp_logger_type), POINTER :: logger
152 TYPE(dbcsr_distribution_type), POINTER :: dbcsr_dist
153 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s, p_im, p_xyz, rho_new
154 TYPE(dbcsr_type), POINTER :: tmp_ao
155 TYPE(dft_control_type), POINTER :: dft_control
156 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
157 POINTER :: sab_all, sab_orb
158 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
159 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
160 TYPE(qs_rho_type), POINTER :: rho
161 TYPE(rt_prop_type), POINTER :: rtp
162 TYPE(section_vals_type), POINTER :: dft_section, input, rtp_section
163
164 NULLIFY (logger, dft_control)
165
166 logger => cp_get_default_logger()
167 CALL get_qs_env(qs_env, &
168 rtp=rtp, &
169 matrix_s=matrix_s, &
170 input=input, &
171 rho=rho, &
172 particle_set=particle_set, &
173 atomic_kind_set=atomic_kind_set, &
174 qs_kind_set=qs_kind_set, &
175 dft_control=dft_control, sab_all=sab_all, sab_orb=sab_orb, &
176 dbcsr_dist=dbcsr_dist, nelectron_spin=nelectron_spin)
177
178 rtp_section => section_vals_get_subs_vals(input, "DFT%REAL_TIME_PROPAGATION")
179
180 CALL get_qs_kind_set(qs_kind_set, nelectron=n_electrons)
181 n_electrons = n_electrons - dft_control%charge
182
183 CALL qs_rho_get(rho_struct=rho, tot_rho_r=qs_tot_rho_r)
184
185 tot_rho_r = accurate_sum(qs_tot_rho_r)
186
187 output_unit = cp_print_key_unit_nr(logger, rtp_section, "PRINT%PROGRAM_RUN_INFO", &
188 extension=".scfLog")
189
190 IF (output_unit > 0) THEN
191 WRITE (output_unit, fmt="(/,(T3,A,T40,I5))") &
192 "Information at iteration step:", rtp%iter
193 WRITE (unit=output_unit, fmt="((T3,A,T41,2F20.10))") &
194 "Total electronic density (r-space): ", &
195 tot_rho_r, &
196 tot_rho_r + &
197 REAL(n_electrons, dp)
198 WRITE (unit=output_unit, fmt="((T3,A,T59,F22.14))") &
199 "Total energy:", rtp%energy_new
200 IF (run_type == ehrenfest) &
201 WRITE (unit=output_unit, fmt="((T3,A,T61,F20.14))") &
202 "Energy difference to previous iteration step:", rtp%energy_new - rtp%energy_old
203 IF (run_type == real_time_propagation) &
204 WRITE (unit=output_unit, fmt="((T3,A,T61,F20.14))") &
205 "Energy difference to initial state:", rtp%energy_new - rtp%energy_old
206 IF (PRESENT(delta_iter)) &
207 WRITE (unit=output_unit, fmt="((T3,A,T61,E20.6))") &
208 "Convergence:", delta_iter
209 IF (rtp%converged) THEN
210 IF (run_type == real_time_propagation) &
211 WRITE (unit=output_unit, fmt="((T3,A,T61,F12.2))") &
212 "Time needed for propagation:", used_time
213 WRITE (unit=output_unit, fmt="(/,(T3,A,3X,F16.14))") &
214 "CONVERGENCE REACHED", rtp%energy_new - rtp%energy_old
215 END IF
216 END IF
217
218 IF (rtp%converged) THEN
219 IF (.NOT. rtp%linear_scaling) THEN
220 CALL get_rtp(rtp=rtp, mos_new=mos_new)
221 CALL rt_calculate_orthonormality(orthonormality, &
222 mos_new, matrix_s(1)%matrix)
223 IF (output_unit > 0) &
224 WRITE (output_unit, fmt="(/,(T3,A,T60,F20.10))") &
225 "Max deviation from orthonormalization:", orthonormality
226 END IF
227 END IF
228
229 IF (output_unit > 0) &
230 CALL m_flush(output_unit)
231 CALL cp_print_key_finished_output(output_unit, logger, rtp_section, &
232 "PRINT%PROGRAM_RUN_INFO")
233
234 IF (rtp%converged) THEN
235 dft_section => section_vals_get_subs_vals(input, "DFT")
236 IF (btest(cp_print_key_should_output(logger%iter_info, &
237 dft_section, "REAL_TIME_PROPAGATION%PRINT%FIELD"), cp_p_file)) &
238 CALL print_field_applied(qs_env, dft_section)
239 CALL make_moment(qs_env)
240 IF (btest(cp_print_key_should_output(logger%iter_info, &
241 dft_section, "REAL_TIME_PROPAGATION%PRINT%E_CONSTITUENTS"), cp_p_file)) THEN
242 CALL print_rtp_energy_components(qs_env, dft_section)
243 END IF
244 IF (.NOT. dft_control%qs_control%dftb) THEN
245 CALL write_available_results(qs_env=qs_env, rtp=rtp)
246 END IF
247
248 IF (rtp%linear_scaling) THEN
249 CALL get_rtp(rtp=rtp, rho_new=rho_new)
250
251 ! Probably have to rebuild the moment matrix, since atoms can also move, in principle
252 IF (dft_control%rtp_control%save_local_moments) THEN
253 ! Save the field value
254 IF (dft_control%apply_efield_field) THEN
255 CALL make_field(dft_control, field, qs_env%sim_step, qs_env%sim_time)
256 rtp%fields(:, rtp%istep + rtp%i_start + 1) = cmplx(field(:), 0.0, kind=dp)
257 END IF
258 IF (.NOT. dft_control%rtp_control%fixed_ions) THEN
259 CALL build_local_moment_matrix(qs_env, rtp%local_moments, 1, reference_point)
260 END IF
261 ! TODO : Is symmetric rho possible?
262 ! Spin + complex parts
263 ! Extensions setup
264 CALL calc_local_moment(rtp%local_moments, rho_new, &
265 rtp%local_moments_work, rtp%moments(:, :, rtp%istep + rtp%i_start + 1))
266 ! Time 1 is zero (start) time
267 rtp%times(rtp%istep + rtp%i_start + 1) = qs_env%sim_time
268 output_unit = cp_logger_get_default_io_unit(logger)
269 CALL print_moments(section_vals_get_subs_vals(rtp_section, "PRINT%MOMENTS"), output_unit, &
270 rtp%moments(:, :, rtp%istep + rtp%i_start + 1), qs_env%sim_time, rtp%track_imag_density)
271 END IF
272
273 IF (btest(cp_print_key_should_output(logger%iter_info, &
274 dft_section, "REAL_TIME_PROPAGATION%PRINT%RESTART"), cp_p_file)) THEN
275 CALL write_rt_p_to_restart(rho_new, .false.)
276 END IF
277 IF (btest(cp_print_key_should_output(logger%iter_info, &
278 dft_section, "REAL_TIME_PROPAGATION%PRINT%RESTART_HISTORY"), cp_p_file)) THEN
279 CALL write_rt_p_to_restart(rho_new, .true.)
280 END IF
281 IF (.NOT. dft_control%qs_control%dftb) THEN
282 !Not sure if these things could also work with dftb or not
283 IF (btest(cp_print_key_should_output(logger%iter_info, &
284 dft_section, "REAL_TIME_PROPAGATION%PRINT%CURRENT"), cp_p_file)) THEN
285 DO spin = 1, SIZE(rho_new)/2
286 CALL rt_current(qs_env, rho_new(2*spin)%matrix, dft_section, spin, SIZE(rho_new)/2)
287 END DO
288 END IF
289 END IF
290 ELSE
291 CALL get_rtp(rtp=rtp, mos_new=mos_new)
292 IF (.NOT. dft_control%qs_control%dftb .AND. .NOT. dft_control%qs_control%xtb) THEN
293 IF (rtp%track_imag_density) THEN
294 NULLIFY (p_im, p_xyz)
295 CALL dbcsr_allocate_matrix_set(p_xyz, 3)
296
297! Linear momentum operator
298! prepare for allocation
299 natom = SIZE(particle_set, 1)
300 ALLOCATE (first_sgf(natom))
301 ALLOCATE (last_sgf(natom))
302 CALL get_particle_set(particle_set, qs_kind_set, &
303 first_sgf=first_sgf, &
304 last_sgf=last_sgf)
305 ALLOCATE (row_blk_sizes(natom))
306 CALL dbcsr_convert_offsets_to_sizes(first_sgf, row_blk_sizes, last_sgf)
307 DEALLOCATE (first_sgf)
308 DEALLOCATE (last_sgf)
309
310 ALLOCATE (p_xyz(1)%matrix)
311 CALL dbcsr_create(matrix=p_xyz(1)%matrix, &
312 name="p_xyz", &
313 dist=dbcsr_dist, matrix_type=dbcsr_type_antisymmetric, &
314 row_blk_size=row_blk_sizes, col_blk_size=row_blk_sizes, &
315 mutable_work=.true.)
316 CALL cp_dbcsr_alloc_block_from_nbl(p_xyz(1)%matrix, sab_orb)
317 CALL dbcsr_set(p_xyz(1)%matrix, 0.0_dp)
318 DO i = 2, 3
319 ALLOCATE (p_xyz(i)%matrix)
320 CALL dbcsr_copy(p_xyz(i)%matrix, p_xyz(1)%matrix, "p_xyz-"//trim(adjustl(cp_to_string(i))))
321 CALL dbcsr_set(p_xyz(i)%matrix, 0.0_dp)
322 END DO
323 CALL build_lin_mom_matrix(qs_env, p_xyz)
324 DEALLOCATE (row_blk_sizes)
325
326 nspin = SIZE(mos_new)/2
327 CALL qs_rho_get(rho, rho_ao_im=p_im)
328 ALLOCATE (j_int(nspin, 3))
329 j_int = 0.0_dp
330
331 NULLIFY (tmp_ao)
332 CALL dbcsr_init_p(tmp_ao)
333 CALL dbcsr_create(tmp_ao, template=matrix_s(1)%matrix, matrix_type=dbcsr_type_no_symmetry, name="tmp")
334 CALL cp_dbcsr_alloc_block_from_nbl(tmp_ao, sab_all)
335 CALL dbcsr_set(tmp_ao, 0.0_dp)
336
337 DO i = 1, 3
338 strace = 0.0_dp
339 DO spin = 1, nspin
340 CALL dbcsr_set(tmp_ao, 0.0_dp)
341 CALL dbcsr_multiply("T", "N", 1.0_dp, p_im(spin)%matrix, p_xyz(i)%matrix, &
342 0.0_dp, tmp_ao)
343 CALL dbcsr_trace(tmp_ao, trace)
344 strace = strace + trace
345! dft_control%rtp_control%vec_pot(1)
346 j_int(spin, i) = -trace + dft_control%rtp_control%vec_pot(i)*nelectron_spin(spin)
347!! j_int(spin, i) = strace
348 END DO
349 END DO
350! PP term missing
351
352 IF (btest(cp_print_key_should_output(logger%iter_info, &
353 dft_section, "REAL_TIME_PROPAGATION%PRINT%CURRENT_INT"), cp_p_file)) THEN
354
355 output_unit = cp_logger_get_default_io_unit(logger)
356 unit_nr = cp_print_key_unit_nr(logger, dft_section, &
357 "REAL_TIME_PROPAGATION%PRINT%CURRENT_INT", extension=".dat", is_new_file=new_file)
358
359 IF (output_unit > 0) THEN
360 IF (new_file) THEN
361 IF (nspin == 2) THEN
362 WRITE (unit=unit_nr, fmt='("#",5X,A,4X,A,2X,A,2(10X,A),4X,A,2(10X,A))') &
363 "Step Nr.", "Time[fs]", "ALPHA jint[X]", "jint[Y]", "jint[Z]", &
364 "BETA jint[X]", "jint[Y]", "jint[Z]"
365 ELSE
366 WRITE (unit=unit_nr, fmt='("#",5X,A,4X,A,8X,A,2(10X,A))') "Step Nr.", "Time[fs]", &
367 "jint[X]", "jint[Y]", "jint[Z]"
368 END IF
369 END IF
370
371 IF (nspin == 2) THEN
372 WRITE (unit=unit_nr, fmt="(I10,F16.6,6(F16.8,1X))") qs_env%sim_step, qs_env%sim_time*femtoseconds, &
373 j_int(1, 1:3), j_int(2, 1:3)
374 ELSE
375 WRITE (unit=unit_nr, fmt="(I10,F16.6,3(F16.8,1X))") qs_env%sim_step, qs_env%sim_time*femtoseconds, &
376 j_int(1, 1:3)
377 END IF
378 END IF
379 CALL cp_print_key_finished_output(unit_nr, logger, dft_section, &
380 "REAL_TIME_PROPAGATION%PRINT%CURRENT_INT")
381 END IF
382 DEALLOCATE (j_int)
383
384 IF (btest(cp_print_key_should_output(logger%iter_info, &
385 dft_section, "REAL_TIME_PROPAGATION%PRINT%CURRENT"), cp_p_file)) THEN
386 DO spin = 1, nspin
387 CALL rt_current(qs_env, p_im(spin)%matrix, dft_section, spin, nspin)
388 END DO
389 END IF
390 CALL dbcsr_deallocate_matrix(tmp_ao)
392 END IF
393
394! projection of molecular orbitals
395 IF (dft_control%rtp_control%is_proj_mo) THEN
396 DO n_proj = 1, SIZE(dft_control%rtp_control%proj_mo_list)
397 CALL compute_and_write_proj_mo(qs_env, mos_new, &
398 dft_control%rtp_control%proj_mo_list(n_proj)%proj_mo, n_proj)
399 END DO
400 END IF
401 END IF
402 CALL write_rt_mos_to_restart(qs_env%mos, mos_new, particle_set, &
403 dft_section, qs_kind_set)
404 END IF
405 END IF
406
407 rtp%energy_old = rtp%energy_new
408
409 IF (.NOT. rtp%converged .AND. rtp%iter >= dft_control%rtp_control%max_iter) &
410 CALL cp_abort(__location__, "EMD did not converge, either increase MAX_ITER "// &
411 "or use a smaller TIMESTEP")
412
413 END SUBROUTINE rt_prop_output
414
415! **************************************************************************************************
416!> \brief computes the effective orthonormality of a set of mos given an s-matrix
417!> orthonormality is the max deviation from unity of the C^T S C
418!> \param orthonormality ...
419!> \param mos_new ...
420!> \param matrix_s ...
421!> \author Florian Schiffmann (02.09)
422! **************************************************************************************************
423 SUBROUTINE rt_calculate_orthonormality(orthonormality, mos_new, matrix_s)
424 REAL(kind=dp), INTENT(out) :: orthonormality
425 TYPE(cp_fm_type), DIMENSION(:), POINTER :: mos_new
426 TYPE(dbcsr_type), OPTIONAL, POINTER :: matrix_s
427
428 CHARACTER(len=*), PARAMETER :: routinen = 'rt_calculate_orthonormality'
429
430 INTEGER :: handle, i, im, ispin, j, k, n, &
431 ncol_local, nrow_local, nspin, re
432 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
433 REAL(kind=dp) :: alpha, max_alpha, max_beta
434 TYPE(cp_fm_struct_type), POINTER :: tmp_fm_struct
435 TYPE(cp_fm_type) :: overlap_re, svec_im, svec_re
436
437 NULLIFY (tmp_fm_struct)
438
439 CALL timeset(routinen, handle)
440
441 nspin = SIZE(mos_new)/2
442 max_alpha = 0.0_dp
443 max_beta = 0.0_dp
444 DO ispin = 1, nspin
445 re = ispin*2 - 1
446 im = ispin*2
447 ! get S*C
448 CALL cp_fm_create(svec_re, mos_new(im)%matrix_struct)
449 CALL cp_fm_create(svec_im, mos_new(im)%matrix_struct)
450 CALL cp_fm_get_info(mos_new(im), &
451 nrow_global=n, ncol_global=k)
452 CALL cp_dbcsr_sm_fm_multiply(matrix_s, mos_new(re), &
453 svec_re, k)
454 CALL cp_dbcsr_sm_fm_multiply(matrix_s, mos_new(im), &
455 svec_im, k)
456
457 ! get C^T (S*C)
458 CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=k, ncol_global=k, &
459 para_env=mos_new(re)%matrix_struct%para_env, &
460 context=mos_new(re)%matrix_struct%context)
461 CALL cp_fm_create(overlap_re, tmp_fm_struct)
462
463 CALL cp_fm_struct_release(tmp_fm_struct)
464
465 CALL parallel_gemm('T', 'N', k, k, n, 1.0_dp, mos_new(re), &
466 svec_re, 0.0_dp, overlap_re)
467 CALL parallel_gemm('T', 'N', k, k, n, 1.0_dp, mos_new(im), &
468 svec_im, 1.0_dp, overlap_re)
469
470 CALL cp_fm_release(svec_re)
471 CALL cp_fm_release(svec_im)
472
473 CALL cp_fm_get_info(overlap_re, nrow_local=nrow_local, ncol_local=ncol_local, &
474 row_indices=row_indices, col_indices=col_indices)
475 DO i = 1, nrow_local
476 DO j = 1, ncol_local
477 alpha = overlap_re%local_data(i, j)
478 IF (row_indices(i) == col_indices(j)) alpha = alpha - 1.0_dp
479 max_alpha = max(max_alpha, abs(alpha))
480 END DO
481 END DO
482 CALL cp_fm_release(overlap_re)
483 END DO
484 CALL mos_new(1)%matrix_struct%para_env%max(max_alpha)
485 CALL mos_new(1)%matrix_struct%para_env%max(max_beta)
486 orthonormality = max_alpha
487
488 CALL timestop(handle)
489
490 END SUBROUTINE rt_calculate_orthonormality
491
492! **************************************************************************************************
493!> \brief computes the convergence criterion for RTP and EMD
494!> \param rtp ...
495!> \param matrix_s Overlap matrix without the derivatives
496!> \param delta_mos ...
497!> \param delta_eps ...
498!> \author Florian Schiffmann (02.09)
499! **************************************************************************************************
500
501 SUBROUTINE rt_convergence(rtp, matrix_s, delta_mos, delta_eps)
502 TYPE(rt_prop_type), POINTER :: rtp
503 TYPE(dbcsr_type), POINTER :: matrix_s
504 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: delta_mos
505 REAL(dp), INTENT(out) :: delta_eps
506
507 CHARACTER(len=*), PARAMETER :: routinen = 'rt_convergence'
508 REAL(kind=dp), PARAMETER :: one = 1.0_dp, zero = 0.0_dp
509
510 INTEGER :: handle, i, icol, im, ispin, j, lcol, &
511 lrow, nao, newdim, nmo, nspin, re
512 LOGICAL :: double_col, double_row
513 REAL(kind=dp) :: alpha, max_alpha
514 TYPE(cp_fm_struct_type), POINTER :: newstruct, newstruct1, tmp_fm_struct
515 TYPE(cp_fm_type) :: work, work1, work2
516 TYPE(cp_fm_type), DIMENSION(:), POINTER :: mos_new
517
518 NULLIFY (tmp_fm_struct)
519
520 CALL timeset(routinen, handle)
521
522 CALL get_rtp(rtp=rtp, mos_new=mos_new)
523
524 nspin = SIZE(delta_mos)/2
525 max_alpha = 0.0_dp
526
527 DO i = 1, SIZE(mos_new)
528 CALL cp_fm_scale_and_add(-one, delta_mos(i), one, mos_new(i))
529 END DO
530
531 DO ispin = 1, nspin
532 re = ispin*2 - 1
533 im = ispin*2
534
535 double_col = .true.
536 double_row = .false.
537 CALL cp_fm_struct_double(newstruct, &
538 delta_mos(re)%matrix_struct, &
539 delta_mos(re)%matrix_struct%context, &
540 double_col, &
541 double_row)
542
543 CALL cp_fm_create(work, matrix_struct=newstruct)
544 CALL cp_fm_create(work1, matrix_struct=newstruct)
545
546 CALL cp_fm_get_info(delta_mos(re), ncol_local=lcol, ncol_global=nmo, &
547 nrow_global=nao)
548 CALL cp_fm_get_info(work, ncol_global=newdim)
549
550 CALL cp_fm_set_all(work, zero, zero)
551
552 DO icol = 1, lcol
553 work%local_data(:, icol) = delta_mos(re)%local_data(:, icol)
554 work%local_data(:, icol + lcol) = delta_mos(im)%local_data(:, icol)
555 END DO
556
557 CALL cp_dbcsr_sm_fm_multiply(matrix_s, work, work1, ncol=newdim)
558
559 CALL cp_fm_release(work)
560
561 CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nmo, ncol_global=nmo, &
562 para_env=delta_mos(re)%matrix_struct%para_env, &
563 context=delta_mos(re)%matrix_struct%context)
564 CALL cp_fm_struct_double(newstruct1, &
565 tmp_fm_struct, &
566 delta_mos(re)%matrix_struct%context, &
567 double_col, &
568 double_row)
569
570 CALL cp_fm_create(work, matrix_struct=newstruct1)
571 CALL cp_fm_create(work2, matrix_struct=newstruct1)
572
573 CALL parallel_gemm("T", "N", nmo, newdim, nao, one, delta_mos(re), &
574 work1, zero, work)
575
576 CALL parallel_gemm("T", "N", nmo, newdim, nao, one, delta_mos(im), &
577 work1, zero, work2)
578
579 CALL cp_fm_get_info(work, nrow_local=lrow)
580 DO i = 1, lrow
581 DO j = 1, lcol
582 alpha = sqrt((work%local_data(i, j) + work2%local_data(i, j + lcol))**2 + &
583 (work%local_data(i, j + lcol) - work2%local_data(i, j))**2)
584 max_alpha = max(max_alpha, abs(alpha))
585 END DO
586 END DO
587
588 CALL cp_fm_release(work)
589 CALL cp_fm_release(work1)
590 CALL cp_fm_release(work2)
591 CALL cp_fm_struct_release(tmp_fm_struct)
592 CALL cp_fm_struct_release(newstruct)
593 CALL cp_fm_struct_release(newstruct1)
594
595 END DO
596
597 CALL delta_mos(1)%matrix_struct%para_env%max(max_alpha)
598 delta_eps = sqrt(max_alpha)
599
600 CALL timestop(handle)
601
602 END SUBROUTINE rt_convergence
603
604! **************************************************************************************************
605!> \brief computes the convergence criterion for RTP and EMD based on the density matrix
606!> \param rtp ...
607!> \param delta_P ...
608!> \param delta_eps ...
609!> \author Samuel Andermatt (02.14)
610! **************************************************************************************************
611
612 SUBROUTINE rt_convergence_density(rtp, delta_P, delta_eps)
613
614 TYPE(rt_prop_type), POINTER :: rtp
615 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: delta_p
616 REAL(dp), INTENT(out) :: delta_eps
617
618 CHARACTER(len=*), PARAMETER :: routinen = 'rt_convergence_density'
619 REAL(kind=dp), PARAMETER :: one = 1.0_dp, zero = 0.0_dp
620
621 INTEGER :: col_atom, handle, i, ispin, row_atom
622 REAL(dp) :: alpha, max_alpha
623 REAL(dp), DIMENSION(:, :), POINTER :: block_values
624 TYPE(dbcsr_iterator_type) :: iter
625 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_new
626 TYPE(dbcsr_type), POINTER :: tmp
627 TYPE(mp_comm_type) :: group
628
629 CALL timeset(routinen, handle)
630
631 CALL get_rtp(rtp=rtp, rho_new=rho_new)
632
633 DO i = 1, SIZE(rho_new)
634 CALL dbcsr_add(delta_p(i)%matrix, rho_new(i)%matrix, one, -one)
635 END DO
636 !get the maximum value of delta_P
637 DO i = 1, SIZE(delta_p)
638 !square all entries of both matrices
639 CALL dbcsr_iterator_start(iter, delta_p(i)%matrix)
640 DO WHILE (dbcsr_iterator_blocks_left(iter))
641 CALL dbcsr_iterator_next_block(iter, row_atom, col_atom, block_values)
642 block_values = block_values*block_values
643 END DO
644 CALL dbcsr_iterator_stop(iter)
645 END DO
646 NULLIFY (tmp)
647 ALLOCATE (tmp)
648 CALL dbcsr_create(tmp, template=delta_p(1)%matrix, matrix_type="N")
649 DO ispin = 1, SIZE(delta_p)/2
650 CALL dbcsr_desymmetrize(delta_p(2*ispin - 1)%matrix, tmp)
651 CALL dbcsr_add(delta_p(2*ispin)%matrix, tmp, one, one)
652 END DO
653 !the absolute values are now in the even entries of delta_P
654 max_alpha = zero
655 DO ispin = 1, SIZE(delta_p)/2
656 CALL dbcsr_iterator_start(iter, delta_p(2*ispin)%matrix)
657 DO WHILE (dbcsr_iterator_blocks_left(iter))
658 CALL dbcsr_iterator_next_block(iter, row_atom, col_atom, block_values)
659 alpha = maxval(block_values)
660 IF (alpha > max_alpha) max_alpha = alpha
661 END DO
662 CALL dbcsr_iterator_stop(iter)
663 END DO
664 CALL dbcsr_get_info(delta_p(1)%matrix, group=group)
665 CALL group%max(max_alpha)
666 delta_eps = sqrt(max_alpha)
668 CALL timestop(handle)
669
670 END SUBROUTINE rt_convergence_density
671
672! **************************************************************************************************
673!> \brief interface to qs_moments. Does only work for nonperiodic dipole
674!> \param qs_env ...
675!> \author Florian Schiffmann (02.09)
676! **************************************************************************************************
677
678 SUBROUTINE make_moment(qs_env)
679
680 TYPE(qs_environment_type), POINTER :: qs_env
681
682 CHARACTER(len=*), PARAMETER :: routinen = 'make_moment'
683
684 INTEGER :: handle, output_unit
685 TYPE(cp_logger_type), POINTER :: logger
686 TYPE(dft_control_type), POINTER :: dft_control
687
688 CALL timeset(routinen, handle)
689
690 NULLIFY (dft_control)
691
692 logger => cp_get_default_logger()
693 output_unit = cp_logger_get_default_io_unit(logger)
694 CALL get_qs_env(qs_env, dft_control=dft_control)
695 IF (dft_control%qs_control%dftb) THEN
696 CALL scf_post_calculation_tb(qs_env, "DFTB", .false.)
697 ELSE IF (dft_control%qs_control%xtb) THEN
698 CALL scf_post_calculation_tb(qs_env, "xTB", .false.)
699 ELSE
700 CALL qs_scf_post_moments(qs_env%input, logger, qs_env, output_unit)
701 END IF
702 CALL timestop(handle)
703
704 END SUBROUTINE make_moment
705
706! **************************************************************************************************
707!> \brief Reports the sparsity pattern of the complex density matrix
708!> \param filter_eps ...
709!> \param rho ...
710!> \author Samuel Andermatt (09.14)
711! **************************************************************************************************
712
713 SUBROUTINE report_density_occupation(filter_eps, rho)
714
715 REAL(kind=dp) :: filter_eps
716 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho
717
718 CHARACTER(len=*), PARAMETER :: routinen = 'report_density_occupation'
719
720 INTEGER :: handle, i, im, ispin, re, unit_nr
721 REAL(kind=dp) :: eps, occ
722 TYPE(cp_logger_type), POINTER :: logger
723 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: tmp
724
725 CALL timeset(routinen, handle)
726
727 logger => cp_get_default_logger()
728 unit_nr = cp_logger_get_default_io_unit(logger)
729 NULLIFY (tmp)
730 CALL dbcsr_allocate_matrix_set(tmp, SIZE(rho))
731 DO i = 1, SIZE(rho)
732 CALL dbcsr_init_p(tmp(i)%matrix)
733 CALL dbcsr_create(tmp(i)%matrix, template=rho(i)%matrix)
734 CALL dbcsr_copy(tmp(i)%matrix, rho(i)%matrix)
735 END DO
736 DO ispin = 1, SIZE(rho)/2
737 re = 2*ispin - 1
738 im = 2*ispin
739 eps = max(filter_eps, 1.0e-11_dp)
740 DO WHILE (eps < 1.1_dp)
741 CALL dbcsr_filter(tmp(re)%matrix, eps)
742 occ = dbcsr_get_occupation(tmp(re)%matrix)
743 IF (unit_nr > 0) WRITE (unit_nr, fmt="((T3,A,I1,A,F15.12,A,T61,F20.10))") "Occupation of rho spin ", &
744 ispin, " eps ", eps, " real: ", occ
745 eps = eps*10
746 END DO
747 eps = max(filter_eps, 1.0e-11_dp)
748 DO WHILE (eps < 1.1_dp)
749 CALL dbcsr_filter(tmp(im)%matrix, eps)
750 occ = dbcsr_get_occupation(tmp(im)%matrix)
751 IF (unit_nr > 0) WRITE (unit_nr, fmt="((T3,A,I1,A,F15.12,A,T61,F20.10))") "Occupation of rho spin ", &
752 ispin, " eps ", eps, " imag: ", occ
753 eps = eps*10.0_dp
754 END DO
755 END DO
757 CALL timestop(handle)
758
759 END SUBROUTINE report_density_occupation
760
761! **************************************************************************************************
762!> \brief Writes the density matrix and the atomic positions to a restart file
763!> \param rho_new ...
764!> \param history ...
765!> \author Samuel Andermatt (09.14)
766! **************************************************************************************************
767
768 SUBROUTINE write_rt_p_to_restart(rho_new, history)
769
770 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_new
771 LOGICAL :: history
772
773 CHARACTER(LEN=*), PARAMETER :: routinen = 'write_rt_p_to_restart'
774
775 CHARACTER(LEN=default_path_length) :: file_name, project_name
776 INTEGER :: handle, im, ispin, re, unit_nr
777 REAL(kind=dp) :: cs_pos
778 TYPE(cp_logger_type), POINTER :: logger
779
780 CALL timeset(routinen, handle)
781 logger => cp_get_default_logger()
782 IF (logger%para_env%is_source()) THEN
783 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
784 ELSE
785 unit_nr = -1
786 END IF
787
788 project_name = logger%iter_info%project_name
789 DO ispin = 1, SIZE(rho_new)/2
790 re = 2*ispin - 1
791 im = 2*ispin
792 IF (history) THEN
793 WRITE (file_name, '(A,I0,A)') &
794 trim(project_name)//"_LS_DM_SPIN_RE", ispin, "_"//trim(cp_iter_string(logger%iter_info))//"_RESTART.dm"
795 ELSE
796 WRITE (file_name, '(A,I0,A)') trim(project_name)//"_LS_DM_SPIN_RE", ispin, "_RESTART.dm"
797 END IF
798 cs_pos = dbcsr_checksum(rho_new(re)%matrix, pos=.true.)
799 IF (unit_nr > 0) THEN
800 WRITE (unit_nr, '(T2,A,E20.8)') "Writing restart DM "//trim(file_name)//" with checksum: ", cs_pos
801 END IF
802 CALL dbcsr_binary_write(rho_new(re)%matrix, file_name)
803 IF (history) THEN
804 WRITE (file_name, '(A,I0,A)') &
805 trim(project_name)//"_LS_DM_SPIN_IM", ispin, "_"//trim(cp_iter_string(logger%iter_info))//"_RESTART.dm"
806 ELSE
807 WRITE (file_name, '(A,I0,A)') trim(project_name)//"_LS_DM_SPIN_IM", ispin, "_RESTART.dm"
808 END IF
809 cs_pos = dbcsr_checksum(rho_new(im)%matrix, pos=.true.)
810 IF (unit_nr > 0) THEN
811 WRITE (unit_nr, '(T2,A,E20.8)') "Writing restart DM "//trim(file_name)//" with checksum: ", cs_pos
812 END IF
813 CALL dbcsr_binary_write(rho_new(im)%matrix, file_name)
814 END DO
815
816 CALL timestop(handle)
817
818 END SUBROUTINE write_rt_p_to_restart
819
820! **************************************************************************************************
821!> \brief Collocation of the current and printing of it in a cube file
822!> \param qs_env ...
823!> \param P_im ...
824!> \param dft_section ...
825!> \param spin ...
826!> \param nspin ...
827!> \author Samuel Andermatt (06.15)
828! **************************************************************************************************
829 SUBROUTINE rt_current(qs_env, P_im, dft_section, spin, nspin)
830 TYPE(qs_environment_type), POINTER :: qs_env
831 TYPE(dbcsr_type), POINTER :: p_im
832 TYPE(section_vals_type), POINTER :: dft_section
833 INTEGER :: spin, nspin
834
835 CHARACTER(len=*), PARAMETER :: routinen = 'rt_current'
836
837 CHARACTER(len=1) :: char_spin
838 CHARACTER(len=14) :: ext
839 CHARACTER(len=2) :: sdir
840 INTEGER :: dir, handle, print_unit
841 INTEGER, DIMENSION(:), POINTER :: stride(:)
842 LOGICAL :: mpi_io
843 TYPE(cp_logger_type), POINTER :: logger
844 TYPE(current_env_type) :: current_env
845 TYPE(dbcsr_type), POINTER :: tmp, zero
846 TYPE(particle_list_type), POINTER :: particles
847 TYPE(pw_c1d_gs_type) :: gs
848 TYPE(pw_env_type), POINTER :: pw_env
849 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
850 TYPE(pw_r3d_rs_type) :: rs
851 TYPE(qs_subsys_type), POINTER :: subsys
852
853 CALL timeset(routinen, handle)
854
855 logger => cp_get_default_logger()
856 CALL get_qs_env(qs_env=qs_env, subsys=subsys, pw_env=pw_env)
857 CALL qs_subsys_get(subsys, particles=particles)
858 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
859
860 NULLIFY (zero, tmp)
861 ALLOCATE (zero, tmp)
862 CALL dbcsr_create(zero, template=p_im)
863 CALL dbcsr_copy(zero, p_im)
864 CALL dbcsr_set(zero, 0.0_dp)
865 CALL dbcsr_create(tmp, template=p_im)
866 CALL dbcsr_copy(tmp, p_im)
867 IF (nspin == 1) THEN
868 CALL dbcsr_scale(tmp, 0.5_dp)
869 END IF
870 current_env%gauge = -1
871 current_env%gauge_init = .false.
872 CALL auxbas_pw_pool%create_pw(rs)
873 CALL auxbas_pw_pool%create_pw(gs)
874
875 NULLIFY (stride)
876 ALLOCATE (stride(3))
877
878 DO dir = 1, 3
879
880 CALL pw_zero(rs)
881 CALL pw_zero(gs)
882
883 CALL calculate_jrho_resp(zero, tmp, zero, zero, dir, dir, rs, gs, qs_env, current_env, retain_rsgrid=.true.)
884
885 stride = section_get_ivals(dft_section, "REAL_TIME_PROPAGATION%PRINT%CURRENT%STRIDE")
886
887 IF (dir == 1) THEN
888 sdir = "-x"
889 ELSEIF (dir == 2) THEN
890 sdir = "-y"
891 ELSE
892 sdir = "-z"
893 END IF
894 WRITE (char_spin, "(I1)") spin
895
896 ext = "-SPIN-"//char_spin//sdir//".cube"
897 mpi_io = .true.
898 print_unit = cp_print_key_unit_nr(logger, dft_section, "REAL_TIME_PROPAGATION%PRINT%CURRENT", &
899 extension=ext, file_status="REPLACE", file_action="WRITE", &
900 log_filename=.false., mpi_io=mpi_io)
901
902 CALL cp_pw_to_cube(rs, print_unit, "EMD current", particles=particles, stride=stride, &
903 mpi_io=mpi_io)
904
905 CALL cp_print_key_finished_output(print_unit, logger, dft_section, "REAL_TIME_PROPAGATION%PRINT%CURRENT", &
906 mpi_io=mpi_io)
907
908 END DO
909
910 CALL auxbas_pw_pool%give_back_pw(rs)
911 CALL auxbas_pw_pool%give_back_pw(gs)
912
915
916 DEALLOCATE (stride)
917
918 CALL timestop(handle)
919
920 END SUBROUTINE rt_current
921
922! **************************************************************************************************
923!> \brief Interface routine to trigger writing of results available from normal
924!> SCF. Can write MO-dependent and MO free results (needed for call from
925!> the linear scaling code)
926!> Update: trigger also some of prints for time-dependent runs
927!> \param qs_env ...
928!> \param rtp ...
929!> \par History
930!> 2022-11 Update [Guillaume Le Breton]
931! **************************************************************************************************
932 SUBROUTINE write_available_results(qs_env, rtp)
933 TYPE(qs_environment_type), POINTER :: qs_env
934 TYPE(rt_prop_type), POINTER :: rtp
935
936 CHARACTER(len=*), PARAMETER :: routinen = 'write_available_results'
937
938 INTEGER :: handle
939 TYPE(qs_scf_env_type), POINTER :: scf_env
940
941 CALL timeset(routinen, handle)
942
943 CALL get_qs_env(qs_env, scf_env=scf_env)
944 IF (rtp%linear_scaling) THEN
945 CALL write_mo_free_results(qs_env)
946 ELSE
947 CALL write_mo_free_results(qs_env)
948 CALL write_mo_dependent_results(qs_env, scf_env)
949 ! Time-dependent MO print
950 CALL write_rtp_mos_to_output_unit(qs_env, rtp)
951 CALL write_rtp_mo_cubes(qs_env, rtp)
952 END IF
953
954 CALL timestop(handle)
955
956 END SUBROUTINE write_available_results
957
958! **************************************************************************************************
959!> \brief Print the field applied to the system. Either the electric
960!> field or the vector potential depending on the gauge used
961!> \param qs_env ...
962!> \param dft_section ...
963!> \par History
964!> 2023-01 Created [Guillaume Le Breton]
965! **************************************************************************************************
966 SUBROUTINE print_field_applied(qs_env, dft_section)
967 TYPE(qs_environment_type), POINTER :: qs_env
968 TYPE(section_vals_type), POINTER :: dft_section
969
970 CHARACTER(LEN=3), DIMENSION(3) :: rlab
971 CHARACTER(LEN=default_path_length) :: filename
972 INTEGER :: i, i_step, output_unit, unit_nr
973 LOGICAL :: new_file
974 REAL(kind=dp) :: field(3)
975 TYPE(cp_logger_type), POINTER :: logger
976 TYPE(dft_control_type), POINTER :: dft_control
977 TYPE(rt_prop_type), POINTER :: rtp
978
979 NULLIFY (dft_control)
980
981 logger => cp_get_default_logger()
982 output_unit = cp_logger_get_default_io_unit(logger)
983
984 CALL get_qs_env(qs_env, dft_control=dft_control, rtp=rtp)
985
986 i_step = rtp%istep
987
988 unit_nr = cp_print_key_unit_nr(logger, dft_section, &
989 "REAL_TIME_PROPAGATION%PRINT%FIELD", extension=".dat", is_new_file=new_file)
990
991 IF (output_unit > 0) THEN
992 rlab = [CHARACTER(LEN=3) :: "X", "Y", "Z"]
993 IF (unit_nr /= output_unit) THEN
994 INQUIRE (unit=unit_nr, name=filename)
995 WRITE (unit=output_unit, fmt="(/,T2,A,2(/,T3,A),/)") &
996 "FIELD", "The field applied is written to the file:", &
997 trim(filename)
998 ELSE
999 WRITE (unit=output_unit, fmt="(/,T2,A)") "FIELD APPLIED [a.u.]"
1000 WRITE (unit=output_unit, fmt="(T5,3(A,A,E16.8,1X))") &
1001 (trim(rlab(i)), "=", dft_control%rtp_control%field(i), i=1, 3)
1002 END IF
1003
1004 IF (new_file) THEN
1005 IF (dft_control%apply_efield_field) THEN
1006 WRITE (unit=unit_nr, fmt='("#",5X,A,8X,A,3(6X,A))') "Step Nr.", "Time[fs]", " Field X", " Field Y", " Field Z"
1007 ELSE IF (dft_control%apply_vector_potential) THEN
1008 WRITE (unit=unit_nr, fmt='("#",5X,A,8X,A,6(6X,A))') "Step Nr.", "Time[fs]", " Field X", " Field Y", " Field Z", &
1009 " Vec. Pot. X", " Vec. Pot. Y", " Vec. Pot. Z"
1010 END IF
1011 END IF
1012
1013 field = 0.0_dp
1014 IF (dft_control%apply_efield_field) THEN
1015 CALL make_field(dft_control, field, qs_env%sim_step, qs_env%sim_time)
1016 WRITE (unit=unit_nr, fmt="(I10,F16.6,3(F16.8,1X))") qs_env%sim_step, qs_env%sim_time*femtoseconds, &
1017 field(1), field(2), field(3)
1018! DO i=1,3
1019! IF (ABS(field(i))< 10E-10) field(i) = 0.0_dp
1020! END IF
1021 ELSE IF (dft_control%apply_vector_potential) THEN
1022 WRITE (unit=unit_nr, fmt="(I10,F16.6,6(F16.8,1X))") qs_env%sim_step, qs_env%sim_time*femtoseconds, &
1023 dft_control%rtp_control%field(1), dft_control%rtp_control%field(2), dft_control%rtp_control%field(3), &
1024 dft_control%rtp_control%vec_pot(1), dft_control%rtp_control%vec_pot(2), dft_control%rtp_control%vec_pot(3)
1025 END IF
1026
1027 END IF
1028
1029 CALL cp_print_key_finished_output(unit_nr, logger, dft_section, &
1030 "REAL_TIME_PROPAGATION%PRINT%FIELD")
1031
1032 END SUBROUTINE print_field_applied
1033
1034! **************************************************************************************************
1035!> \brief Print the components of the total energy used in an RTP calculation
1036!> \param qs_env ...
1037!> \param dft_section ...
1038!> \par History
1039!> 2024-02 Created [ANB]
1040! **************************************************************************************************
1041 SUBROUTINE print_rtp_energy_components(qs_env, dft_section)
1042 TYPE(qs_environment_type), POINTER :: qs_env
1043 TYPE(section_vals_type), POINTER :: dft_section
1044
1045 CHARACTER(LEN=default_path_length) :: filename
1046 INTEGER :: i_step, output_unit, unit_nr
1047 LOGICAL :: new_file
1048 TYPE(cp_logger_type), POINTER :: logger
1049 TYPE(dft_control_type), POINTER :: dft_control
1050 TYPE(qs_energy_type), POINTER :: energy
1051 TYPE(rt_prop_type), POINTER :: rtp
1052
1053 NULLIFY (dft_control, energy, rtp)
1054
1055 logger => cp_get_default_logger()
1056 output_unit = cp_logger_get_default_io_unit(logger)
1057
1058 CALL get_qs_env(qs_env, dft_control=dft_control, rtp=rtp, energy=energy)
1059 i_step = rtp%istep
1060
1061 unit_nr = cp_print_key_unit_nr(logger, dft_section, &
1062 "REAL_TIME_PROPAGATION%PRINT%E_CONSTITUENTS", extension=".ener", &
1063 file_action="WRITE", is_new_file=new_file)
1064
1065 IF (output_unit > 0) THEN
1066 IF (unit_nr /= output_unit) THEN
1067 INQUIRE (unit=unit_nr, name=filename)
1068 WRITE (unit=output_unit, fmt="(/,T2,A,2(/,T3,A),/)") &
1069 "ENERGY_CONSTITUENTS", "Total Energy constituents written to file:", &
1070 trim(filename)
1071 ELSE
1072 WRITE (unit=output_unit, fmt="(/,T2,A)") "ENERGY_CONSTITUENTS"
1073 END IF
1074
1075 IF (new_file) THEN
1076 ! NOTE that these are not all terms contributing to the total energy for RTP, only a selection of those
1077 ! most significant / impactful. Therefore the printed components likely will not add up to the total energy.
1078 WRITE (unit=unit_nr, fmt='("#",5X,A,8X,A,10(6X,A))') "Step Nr.", "Time[fs]", &
1079 "Total ener.[a.u.]", "core[a.u.] ", " overlap [a.u.]", "hartree[a.u.]", " exc. [a.u.] ", &
1080 " hartree 1c[a.u.]", "exc 1c[a.u.] ", "exc admm[a.u.]", "exc 1c admm[a.u.]", "efield LG"
1081
1082 END IF
1083 WRITE (unit=unit_nr, fmt="(I10,F20.6,10(F20.9))") &
1084 qs_env%sim_step, qs_env%sim_time*femtoseconds, &
1085 energy%total, energy%core, energy%core_overlap, energy%hartree, energy%exc, &
1086 energy%hartree_1c, energy%exc1, energy%exc_aux_fit, energy%exc1_aux_fit, energy%efield_core
1087
1088 END IF
1089
1090 CALL cp_print_key_finished_output(unit_nr, logger, dft_section, &
1091 "REAL_TIME_PROPAGATION%PRINT%E_CONSTITUENTS")
1092
1093 END SUBROUTINE print_rtp_energy_components
1094
1095! **************************************************************************************************
1096!> \brief Print the dipole moments into a file
1097!> \param moments_section Section of the input defining the file/stream to print the moments to
1098!> \param info_unit Unit where standard output from the program is written - for add. identifiers
1099!> \param moments Actual moment values (for specific time step)
1100!> \param time Current simulation time
1101!> \param imag_opt Whether to calculate the imaginary part
1102!> \param append_opt ...
1103!> \par History
1104!> 10.2025 Created [Marek]
1105! **************************************************************************************************
1106 SUBROUTINE print_moments(moments_section, info_unit, moments, time, imag_opt, append_opt)
1107 TYPE(section_vals_type), POINTER :: moments_section
1108 INTEGER :: info_unit
1109 COMPLEX(kind=dp), DIMENSION(:, :) :: moments
1110 REAL(kind=dp), OPTIONAL :: time
1111 LOGICAL, OPTIONAL :: imag_opt, append_opt
1112
1113 CHARACTER(len=14), DIMENSION(4) :: file_extensions
1114 CHARACTER(len=21) :: prefix
1115 COMPLEX(kind=dp), DIMENSION(3, 1) :: moment_t
1116 INTEGER :: i, ndir, nspin, print_unit
1117 LOGICAL :: append, imaginary
1118 TYPE(cp_logger_type), POINTER :: logger
1119
1120! Index 1 : spin, Index 2 : direction
1121
1122 nspin = SIZE(moments, 1)
1123 ndir = SIZE(moments, 2)
1124
1125 IF (nspin < 1) cpabort("Zero spin index size in print moments!")
1126 IF (ndir < 1) cpabort("Zero direction index size in print moments!")
1127
1128 imaginary = .true.
1129 IF (PRESENT(imag_opt)) imaginary = imag_opt
1130
1131 append = .true.
1132 IF (PRESENT(append_opt)) append = append_opt
1133
1134 ! Get the program run info unit and target unit
1135 ! If these are the same (most likely the case of __STD_OUT__), add
1136 ! extra identifier to the printed output
1137 file_extensions(1) = "_SPIN_A_RE.dat"
1138 file_extensions(2) = "_SPIN_A_IM.dat"
1139 file_extensions(3) = "_SPIN_B_RE.dat"
1140 file_extensions(4) = "_SPIN_B_IM.dat"
1141 logger => cp_get_default_logger()
1142 DO i = 1, nspin
1143 moment_t(:, 1) = moments(i, :)
1144 ! Real part
1145 print_unit = cp_print_key_unit_nr(logger, moments_section, extension=file_extensions(2*i - 1))
1146 IF (print_unit == info_unit) THEN
1147 ! print with prefix
1148 prefix = " MOMENTS_TRACE_RE|"
1149 IF (append) THEN
1150 ! Print without headers
1151 CALL print_rt_file(print_unit, xvals=[time], yvals=moment_t, &
1152 prefix=prefix, prefix_format="(A18)", &
1153 xscale_opt=femtoseconds, comp_opt=rt_file_comp_real)
1154 ELSE
1155 ! Print with headers
1156 CALL print_rt_file(print_unit, &
1157 headers=["# Time [fs]", " re(mom_t) x [at.u.]", &
1158 " re(mom_t) y [at.u.]", " re(mom_t) z [at.u.]"], &
1159 xvals=[time], yvals=moment_t, &
1160 prefix=prefix, prefix_format="(A18)", &
1161 xscale_opt=femtoseconds, comp_opt=rt_file_comp_real)
1162 END IF
1163 ELSE
1164 ! Print without prefix
1165 IF (append) THEN
1166 ! Print without headers
1167 CALL print_rt_file(print_unit, xvals=[time], yvals=moment_t, &
1168 xscale_opt=femtoseconds, comp_opt=rt_file_comp_real)
1169 ELSE
1170 ! Print with headers
1171 CALL print_rt_file(print_unit, &
1172 headers=["# Time [fs]", " re(mom_t) x [at.u.]", &
1173 " re(mom_t) y [at.u.]", " re(mom_t) z [at.u.]"], &
1174 xvals=[time], yvals=moment_t, &
1175 xscale_opt=femtoseconds, comp_opt=rt_file_comp_real)
1176 END IF
1177 END IF
1178 CALL cp_print_key_finished_output(print_unit, logger, moments_section)
1179 ! Same for imaginary part
1180 IF (imaginary) THEN
1181 print_unit = cp_print_key_unit_nr(logger, moments_section, extension=file_extensions(2*i))
1182 IF (print_unit == info_unit) THEN
1183 ! print with prefix
1184 prefix = " MOMENTS_TRACE_IM|"
1185 IF (append) THEN
1186 ! Print without headers
1187 CALL print_rt_file(print_unit, xvals=[time], yvals=moment_t, &
1188 prefix=prefix, prefix_format="(A18)", &
1189 xscale_opt=femtoseconds, comp_opt=rt_file_comp_imag)
1190 ELSE
1191 ! Print with headers
1192 CALL print_rt_file(print_unit, &
1193 headers=["# Time [fs]", " im(mom_t) x [at.u.]", &
1194 " im(mom_t) y [at.u.]", " im(mom_t) z [at.u.]"], &
1195 xvals=[time], yvals=moment_t, &
1196 prefix=prefix, prefix_format="(A18)", &
1197 xscale_opt=femtoseconds, comp_opt=rt_file_comp_imag)
1198 END IF
1199 ELSE
1200 ! Print without prefix
1201 IF (append) THEN
1202 ! Print without headers
1203 CALL print_rt_file(print_unit, xvals=[time], yvals=moment_t, &
1204 xscale_opt=femtoseconds, comp_opt=rt_file_comp_imag)
1205 ELSE
1206 ! Print with headers
1207 CALL print_rt_file(print_unit, &
1208 headers=["# Time [fs]", " im(mom_t) x [at.u.]", &
1209 " im(mom_t) y [at.u.]", " im(mom_t) z [at.u.]"], &
1210 xvals=[time], yvals=moment_t, &
1211 xscale_opt=femtoseconds, comp_opt=rt_file_comp_imag)
1212 END IF
1213 END IF
1214 CALL cp_print_key_finished_output(print_unit, logger, moments_section)
1215 END IF
1216 END DO
1217
1218 END SUBROUTINE print_moments
1219
1220! **************************************************************************************************
1221!> \brief Calculate the values of real/imaginary parts of moments in all directions
1222!> \param moment_matrices Local matrix representations of dipole (position) operator
1223!> \param density_matrices Density matrices (spin and real+complex parts)
1224!> \param work Extra dbcsr matrix for work
1225!> \param moment Resulting moments (spin and direction)
1226!> \param imag_opt Whether to calculate the imaginary part of the moment
1227!> \par History
1228!> 10.2025 Created [Marek]
1229! **************************************************************************************************
1230 SUBROUTINE calc_local_moment(moment_matrices, density_matrices, work, moment, imag_opt)
1231 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: moment_matrices, density_matrices
1232 TYPE(dbcsr_type) :: work
1233 COMPLEX(kind=dp), DIMENSION(:, :) :: moment
1234 LOGICAL, OPTIONAL :: imag_opt
1235
1236 INTEGER :: i, k, nspin
1237 LOGICAL :: imag
1238 REAL(kind=dp) :: real_moment
1239
1240 imag = .false.
1241 IF (PRESENT(imag_opt)) imag = imag_opt
1242 nspin = SIZE(density_matrices)/2
1243
1244 DO i = 1, nspin
1245 DO k = 1, 3
1246 CALL dbcsr_multiply("N", "N", -1.0_dp, &
1247 density_matrices(2*i - 1)%matrix, moment_matrices(k)%matrix, &
1248 0.0_dp, work)
1249 CALL dbcsr_trace(work, real_moment)
1250 moment(i, k) = cmplx(real_moment, 0.0, kind=dp)
1251 IF (imag) THEN
1252 CALL dbcsr_multiply("N", "N", -1.0_dp, &
1253 density_matrices(2*i)%matrix, moment_matrices(k)%matrix, &
1254 0.0_dp, work)
1255 CALL dbcsr_trace(work, real_moment)
1256 moment(i, k) = moment(i, k) + cmplx(0.0, real_moment, kind=dp)
1257 END IF
1258 END DO
1259 END DO
1260
1261 END SUBROUTINE calc_local_moment
1262
1263! **************************************************************************************************
1264!> \brief Calculate and print the Fourier transforms + polarizabilites from moment trace
1265!> \param rtp_section The RTP input section (needed to access PRINT configurations)
1266!> \param moments Moment trace
1267!> \param times Corresponding times
1268!> \param fields Corresponding fields
1269!> \param rtc rt_control_type that includes metadata
1270!> \param info_opt ...
1271!> \param cell If present, used to change the delta peak representation to be in units of reciprocal lattice
1272!> \par History
1273!> 10.2025 Created [Marek]
1274! **************************************************************************************************
1275 SUBROUTINE print_ft(rtp_section, moments, times, fields, rtc, info_opt, cell)
1276 TYPE(section_vals_type), POINTER :: rtp_section
1277 COMPLEX(kind=dp), DIMENSION(:, :, :), POINTER :: moments
1278 REAL(kind=dp), DIMENSION(:), POINTER :: times
1279 COMPLEX(kind=dp), DIMENSION(:, :), POINTER :: fields
1280 TYPE(rtp_control_type), POINTER :: rtc
1281 INTEGER, OPTIONAL :: info_opt
1282 TYPE(cell_type), OPTIONAL, POINTER :: cell
1283
1284 CHARACTER(len=11), DIMENSION(2) :: file_extensions
1285 CHARACTER(len=20), ALLOCATABLE, DIMENSION(:) :: headers
1286 CHARACTER(len=21) :: prefix
1287 CHARACTER(len=5) :: prefix_format
1288 COMPLEX(kind=dp), ALLOCATABLE, DIMENSION(:) :: omegas_complex, omegas_pade
1289 COMPLEX(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: field_results, field_results_pade, &
1290 pol_results, pol_results_pade, &
1291 results, results_pade, value_series
1292 INTEGER :: ft_unit, i, info_unit, k, n, n_elems, &
1293 n_pade, nspin
1294 LOGICAL :: do_moments_ft, do_polarizability
1295 REAL(kind=dp) :: damping, t0
1296 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: omegas, omegas_pade_real
1297 REAL(kind=dp), DIMENSION(3) :: delta_vec
1298 TYPE(cp_logger_type), POINTER :: logger
1299 TYPE(section_vals_type), POINTER :: moment_ft_section, pol_section
1300
1301! For results, using spin * direction for first index, e.g. for nspin = 2
1302! results(1,:) = (spin=1 and direction=1,:),
1303! results(5,:) = (spin=2 and direction=2,:)
1304
1305 logger => cp_get_default_logger()
1306
1307 moment_ft_section => section_vals_get_subs_vals(rtp_section, "PRINT%MOMENTS_FT")
1308 pol_section => section_vals_get_subs_vals(rtp_section, "PRINT%POLARIZABILITY")
1309
1310 nspin = SIZE(moments, 1)
1311 n = SIZE(times)
1312 n_elems = SIZE(rtc%print_pol_elements, 1)
1313
1314 info_unit = -1
1315 IF (PRESENT(info_opt)) info_unit = info_opt
1316
1317 ! NOTE : Allows for at most 2 spin species
1318 file_extensions(1) = "_SPIN_A.dat"
1319 file_extensions(2) = "_SPIN_B.dat"
1320
1321 ! Determine whether MOMENTS_FT and/or polarizability needs to be calculated
1322 do_moments_ft = cp_printkey_is_on(logger%iter_info, moment_ft_section)
1323 do_polarizability = cp_printkey_is_on(logger%iter_info, pol_section)
1324 do_polarizability = do_polarizability .AND. (n_elems > 0)
1325
1326 damping = rtc%ft_damping
1327 t0 = rtc%ft_t0
1328
1329 ! Determine field ft if polarizability required
1330 IF (do_polarizability) THEN
1331 ALLOCATE (field_results(3, n))
1332 IF (rtc%apply_delta_pulse) THEN
1333 ! Constant real FT
1334 IF (PRESENT(cell)) THEN
1335 delta_vec(:) = (real(rtc%delta_pulse_direction(1), kind=dp)*cell%h_inv(1, :) + &
1336 REAL(rtc%delta_pulse_direction(2), kind=dp)*cell%h_inv(2, :) + &
1337 REAL(rtc%delta_pulse_direction(3), kind=dp)*cell%h_inv(3, :)) &
1338 *twopi*rtc%delta_pulse_scale
1339 ELSE
1340 delta_vec(:) = real(rtc%delta_pulse_direction(:), kind=dp)*rtc%delta_pulse_scale
1341 END IF
1342 DO k = 1, 3
1343 field_results(k, :) = cmplx(delta_vec(k), 0.0, kind=dp)
1344 END DO
1345 ELSE
1346 ! Do explicit FT
1347 CALL multi_fft(times, fields, field_results, &
1348 damping_opt=damping, t0_opt=t0, subtract_initial_opt=.true.)
1349 END IF
1350 END IF
1351
1352 IF (do_moments_ft .OR. do_polarizability) THEN
1353 ! We need to transform at least the moments
1354 ! NOTE : Might be able to save some memory by only doing FT of actually
1355 ! required moments, but for now, doing FT of all moment directions
1356 ALLOCATE (results(3*nspin, n))
1357 ALLOCATE (omegas(n))
1358 ALLOCATE (value_series(3*nspin, n))
1359 DO i = 1, nspin
1360 DO k = 1, 3
1361 value_series(3*(i - 1) + k, :) = moments(i, k, :)
1362 END DO
1363 END DO
1364 ! TODO : Choose whether the initial subtraction is applied in &FT section?
1365 CALL multi_fft(times, value_series, results, omegas, &
1366 damping_opt=damping, t0_opt=t0, subtract_initial_opt=.true.)
1367 DEALLOCATE (value_series)
1368 DO i = 1, nspin
1369 ! Output to FT file, if needed
1370 ft_unit = cp_print_key_unit_nr(logger, moment_ft_section, extension=file_extensions(i), &
1371 file_form="FORMATTED", file_position="REWIND")
1372 ! Print header
1373 IF (ft_unit > 0) THEN
1374 ALLOCATE (headers(7))
1375 headers(2) = " x,real [at.u.]"
1376 headers(3) = " x,imag [at.u.]"
1377 headers(4) = " y,real [at.u.]"
1378 headers(5) = " y,imag [at.u.]"
1379 headers(6) = " z,real [at.u.]"
1380 headers(7) = " z,imag [at.u.]"
1381 IF (info_unit == ft_unit) THEN
1382 headers(1) = "# Energy [eV]"
1383 prefix = " MOMENTS_FT|"
1384 prefix_format = "(A12)"
1385 CALL print_rt_file(ft_unit, headers, omegas, results(3*(i - 1) + 1:3*(i - 1) + 3, :), &
1386 prefix, prefix_format, evolt)
1387 ELSE
1388 headers(1) = "# omega [at.u.]"
1389 CALL print_rt_file(ft_unit, headers, omegas, results(3*(i - 1) + 1:3*(i - 1) + 3, :))
1390 END IF
1391 DEALLOCATE (headers)
1392 END IF
1393 CALL cp_print_key_finished_output(ft_unit, logger, moment_ft_section)
1394 END DO
1395 END IF
1396
1397 IF (rtc%pade_requested .AND. (do_moments_ft .OR. do_polarizability)) THEN
1398 ALLOCATE (omegas_complex(SIZE(omegas)))
1399 omegas_complex(:) = cmplx(omegas(:), 0.0, kind=dp)
1400 n_pade = int((rtc%pade_e_max - rtc%pade_e_min)/rtc%pade_e_step)
1401 ALLOCATE (omegas_pade(n_pade))
1402 ALLOCATE (omegas_pade_real(n_pade))
1403 ! Construct omegas_pade and omegas_complex
1404 DO i = 1, n_pade
1405 omegas_pade_real(i) = (i - 1)*rtc%pade_e_step + rtc%pade_e_min
1406 omegas_pade(i) = cmplx(omegas_pade_real(i), 0.0, kind=dp)
1407 END DO
1408 ALLOCATE (results_pade(nspin*3, n_pade), source=cmplx(0.0, 0.0, kind=dp))
1409 DO i = 1, nspin
1410 DO k = 1, 3
1411 CALL greenx_refine_ft(rtc%pade_fit_e_min, rtc%pade_fit_e_max, omegas_complex, results(3*(i - 1) + k, :), &
1412 omegas_pade, results_pade(3*(i - 1) + k, :))
1413 END DO
1414 ! Print to a file
1415 ft_unit = cp_print_key_unit_nr(logger, moment_ft_section, extension="_PADE"//file_extensions(i), &
1416 file_form="FORMATTED", file_position="REWIND")
1417 IF (ft_unit > 0) THEN
1418 ALLOCATE (headers(7))
1419 headers(2) = " x,real,pade [at.u.]"
1420 headers(3) = " x,imag,pade [at.u.]"
1421 headers(4) = " y,real,pade [at.u.]"
1422 headers(5) = " y,imag,pade [at.u.]"
1423 headers(6) = " z,real,pade [at.u.]"
1424 headers(7) = " z,imag,pade [at.u.]"
1425 IF (info_unit == ft_unit) THEN
1426 headers(1) = "# Energy [eV]"
1427 prefix = " MOMENTS_FT_PADE|"
1428 prefix_format = "(A17)"
1429 CALL print_rt_file(ft_unit, headers, omegas_pade_real, results_pade(3*(i - 1) + 1:3*(i - 1) + 3, :), &
1430 prefix, prefix_format, evolt)
1431 ELSE
1432 headers(1) = "# omega [at.u.]"
1433 CALL print_rt_file(ft_unit, headers, omegas_pade_real, results_pade(3*(i - 1) + 1:3*(i - 1) + 3, :))
1434 END IF
1435 DEALLOCATE (headers)
1436 END IF
1437 END DO
1438 END IF
1439
1440 IF (do_polarizability) THEN
1441 ! get the polarizability elements, as required
1442 ALLOCATE (pol_results(n_elems, n))
1443 DO i = 1, nspin
1444 DO k = 1, n_elems
1445 ! NOTE - field is regularized to small value
1446 pol_results(k, :) = results(3*(i - 1) + &
1447 rtc%print_pol_elements(k, 1), :)/ &
1448 (field_results(rtc%print_pol_elements(k, 2), :) + &
1449 1.0e-10*field_results(rtc%print_pol_elements(k, 2), 2))
1450 END DO
1451 ! Print to the file
1452 ft_unit = cp_print_key_unit_nr(logger, pol_section, extension=file_extensions(i), &
1453 file_form="FORMATTED", file_position="REWIND")
1454 IF (ft_unit > 0) THEN
1455 ALLOCATE (headers(2*n_elems + 1))
1456 DO k = 1, n_elems
1457 WRITE (headers(2*k), "(A16,I2,I2)") "real pol. elem.", &
1458 rtc%print_pol_elements(k, 1), &
1459 rtc%print_pol_elements(k, 2)
1460 WRITE (headers(2*k + 1), "(A16,I2,I2)") "imag pol. elem.", &
1461 rtc%print_pol_elements(k, 1), &
1462 rtc%print_pol_elements(k, 2)
1463 END DO
1464 ! Write header
1465 IF (info_unit == ft_unit) THEN
1466 headers(1) = "# Energy [eV]"
1467 prefix = " POLARIZABILITY|"
1468 prefix_format = "(A16)"
1469 CALL print_rt_file(ft_unit, headers, omegas, pol_results, &
1470 prefix, prefix_format, evolt)
1471 ELSE
1472 headers(1) = "# omega [at.u.]"
1473 CALL print_rt_file(ft_unit, headers, omegas, pol_results)
1474 END IF
1475 DEALLOCATE (headers)
1476 END IF
1477 CALL cp_print_key_finished_output(ft_unit, logger, pol_section)
1478 END DO
1479 END IF
1480
1481 ! Padé polarizability
1482 IF (rtc%pade_requested .AND. do_polarizability) THEN
1483 ! Start with the field pade
1484 ALLOCATE (field_results_pade(3, n_pade))
1485 IF (rtc%apply_delta_pulse) THEN
1486 DO k = 1, 3
1487 field_results_pade(k, :) = cmplx(delta_vec(k), 0.0, kind=dp)
1488 END DO
1489 ELSE
1490 DO k = 1, 3
1491 CALL greenx_refine_ft(rtc%pade_fit_e_min, rtc%pade_fit_e_max, &
1492 omegas_complex, field_results(k, :), &
1493 omegas_pade, field_results_pade(k, :))
1494 END DO
1495 END IF
1496 ! Allocate polarisation pade
1497 ALLOCATE (pol_results_pade(n_elems, n_pade))
1498 ! Refine
1499 DO i = 1, nspin
1500 DO k = 1, n_elems
1501 ! NOTE : Regularization to small value
1502 pol_results_pade(k, :) = results_pade(3*(i - 1) + rtc%print_pol_elements(k, 1), :)/( &
1503 field_results_pade(rtc%print_pol_elements(k, 2), :) + &
1504 field_results_pade(rtc%print_pol_elements(k, 2), 2)*1.0e-10_dp)
1505 END DO
1506 ! Print to the file
1507 ft_unit = cp_print_key_unit_nr(logger, pol_section, extension="_PADE"//file_extensions(i), &
1508 file_form="FORMATTED", file_position="REWIND")
1509 IF (ft_unit > 0) THEN
1510 ALLOCATE (headers(2*n_elems + 1))
1511 DO k = 1, n_elems
1512 WRITE (headers(2*k), "(A16,I2,I2)") "re,pade,pol.", &
1513 rtc%print_pol_elements(k, 1), &
1514 rtc%print_pol_elements(k, 2)
1515 WRITE (headers(2*k + 1), "(A16,I2,I2)") "im,pade,pol.", &
1516 rtc%print_pol_elements(k, 1), &
1517 rtc%print_pol_elements(k, 2)
1518 END DO
1519 ! Write header
1520 IF (info_unit == ft_unit) THEN
1521 headers(1) = "# Energy [eV]"
1522 prefix = " POLARIZABILITY_PADE|"
1523 prefix_format = "(A21)"
1524 CALL print_rt_file(ft_unit, headers, omegas_pade_real, pol_results_pade, &
1525 prefix, prefix_format, evolt)
1526 ELSE
1527 headers(1) = "# omega [at.u.]"
1528 CALL print_rt_file(ft_unit, headers, omegas_pade_real, pol_results_pade)
1529 END IF
1530 DEALLOCATE (headers)
1531 END IF
1532 CALL cp_print_key_finished_output(ft_unit, logger, pol_section)
1533 END DO
1534 DEALLOCATE (field_results_pade)
1535 DEALLOCATE (pol_results_pade)
1536 END IF
1537
1538 IF (rtc%pade_requested .AND. (do_moments_ft .OR. do_polarizability)) THEN
1539 DEALLOCATE (omegas_complex)
1540 DEALLOCATE (omegas_pade)
1541 DEALLOCATE (omegas_pade_real)
1542 DEALLOCATE (results_pade)
1543 END IF
1544
1545 IF (do_polarizability) THEN
1546 DEALLOCATE (pol_results)
1547 DEALLOCATE (field_results)
1548 END IF
1549
1550 IF (do_moments_ft .OR. do_polarizability) THEN
1551 DEALLOCATE (results)
1552 DEALLOCATE (omegas)
1553 END IF
1554 END SUBROUTINE print_ft
1555
1556! **************************************************************************************************
1557!> \brief ...
1558!> \param rt_unit ...
1559!> \param headers ...
1560!> \param xvals ...
1561!> \param yvals ...
1562!> \param prefix ...
1563!> \param prefix_format ...
1564!> \param xscale_opt ...
1565!> \param comp_opt ...
1566! **************************************************************************************************
1567 SUBROUTINE print_rt_file(rt_unit, headers, xvals, yvals, prefix, prefix_format, xscale_opt, comp_opt)
1568 INTEGER, INTENT(IN) :: rt_unit
1569 CHARACTER(len=20), DIMENSION(:), INTENT(IN), &
1570 OPTIONAL :: headers
1571 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: xvals
1572 COMPLEX(kind=dp), DIMENSION(:, :), INTENT(IN) :: yvals
1573 CHARACTER(len=21), INTENT(IN), OPTIONAL :: prefix
1574 CHARACTER(len=5), INTENT(IN), OPTIONAL :: prefix_format
1575 REAL(kind=dp), INTENT(IN), OPTIONAL :: xscale_opt
1576 INTEGER, OPTIONAL :: comp_opt
1577
1578 INTEGER :: do_comp, i, j, ncols, nrows
1579 LOGICAL :: do_headers, do_prefix
1580 REAL(kind=dp) :: xscale
1581
1582 do_prefix = .false.
1583 IF (PRESENT(prefix)) THEN
1584 IF (PRESENT(prefix_format)) THEN
1585 do_prefix = .true.
1586 ELSE
1587 cpabort("Printing of prefix with missing format!")
1588 END IF
1589 END IF
1590
1591 xscale = 1.0_dp
1592 IF (PRESENT(xscale_opt)) xscale = xscale_opt
1593
1594 ncols = SIZE(yvals, 1)
1595 nrows = SIZE(yvals, 2)
1596
1597 ! Check whether printing complex data (default) or just a component
1598 do_comp = rt_file_comp_both
1599 IF (PRESENT(comp_opt)) do_comp = comp_opt
1600
1601 do_headers = PRESENT(headers)
1602 ! Check whether enough headers for yvals and xvals is present
1603 IF (do_headers) THEN
1604 IF ((do_comp /= rt_file_comp_both .AND. SIZE(headers) < ncols + 1) &
1605 .OR. (do_comp == rt_file_comp_both .AND. SIZE(headers) < 2*ncols + 1)) THEN
1606 cpabort("Not enought headers to print the file!")
1607 END IF
1608 END IF
1609
1610 IF (SIZE(xvals) < nrows) THEN
1611 cpabort("Not enough xvals to print all yvals!")
1612 END IF
1613
1614 IF (rt_unit > 0) THEN
1615 ! Print headers
1616 IF (do_headers) THEN
1617 ! If prefix is present, write prefix
1618 IF (do_prefix) THEN
1619 WRITE (rt_unit, prefix_format, advance="no") prefix
1620 END IF
1621 WRITE (rt_unit, "(A20)", advance="no") headers(1)
1622 ! Print the rest of the headers
1623 SELECT CASE (do_comp)
1624 CASE (rt_file_comp_both)
1625 ! Complex case
1626 DO j = 1, 2*ncols - 1
1627 WRITE (rt_unit, "(A20)", advance="no") headers(j + 1)
1628 END DO
1629 WRITE (rt_unit, "(A20)") headers(2*ncols + 1)
1630 CASE DEFAULT
1631 ! For other cases, just one component is printed
1632 DO j = 1, ncols - 1
1633 WRITE (rt_unit, "(A20)", advance="no") headers(j + 1)
1634 END DO
1635 WRITE (rt_unit, "(A20)") headers(ncols + 1)
1636 END SELECT
1637 END IF
1638 ! Done with the headers, print actual data
1639 DO i = 1, nrows
1640 ! If prefix is present, write prefix
1641 IF (do_prefix) THEN
1642 WRITE (rt_unit, prefix_format, advance="no") prefix
1643 END IF
1644 WRITE (rt_unit, "(E20.8E3)", advance="no") xvals(i)*xscale
1645 DO j = 1, ncols - 1
1646 SELECT CASE (do_comp)
1647 CASE (rt_file_comp_real)
1648 WRITE (rt_unit, "(E20.8E3)", advance="no") &
1649 REAL(yvals(j, i))
1650 CASE (rt_file_comp_imag)
1651 WRITE (rt_unit, "(E20.8E3)", advance="no") &
1652 aimag(yvals(j, i))
1653 CASE DEFAULT
1654 ! Print both components
1655 WRITE (rt_unit, "(E20.8E3,E20.8E3)", advance="no") &
1656 REAL(yvals(j, i)), aimag(yvals(j, i))
1657 END SELECT
1658 END DO
1659 ! Print the final column(s)
1660 SELECT CASE (do_comp)
1661 CASE (rt_file_comp_real)
1662 WRITE (rt_unit, "(E20.8E3)") real(yvals(j, i))
1663 CASE (rt_file_comp_imag)
1664 WRITE (rt_unit, "(E20.8E3)") aimag(yvals(j, i))
1665 CASE DEFAULT
1666 ! Print both components
1667 WRITE (rt_unit, "(E20.8E3,E20.8E3)") &
1668 REAL(yvals(j, i)), aimag(yvals(j, i))
1669 END SELECT
1670 END DO
1671 END IF
1672 END SUBROUTINE print_rt_file
1673
1674END MODULE rt_propagation_output
Define the atomic kind types and their sub types.
Handles all functions related to the CELL.
Definition cell_types.F:15
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
subroutine, public dbcsr_deallocate_matrix(matrix)
...
logical function, public dbcsr_iterator_blocks_left(iterator)
...
subroutine, public dbcsr_iterator_stop(iterator)
...
subroutine, public dbcsr_desymmetrize(matrix_a, matrix_b)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, matrix_c, first_row, last_row, first_column, last_column, first_k, last_k, retain_sparsity, filter_eps, flop)
...
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)
...
subroutine, public dbcsr_init_p(matrix)
...
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset, transposed)
...
subroutine, public dbcsr_filter(matrix, eps)
...
subroutine, public dbcsr_binary_write(matrix, filepath)
...
real(kind=dp) function, public dbcsr_get_occupation(matrix)
...
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
real(kind=dp) function, public dbcsr_checksum(matrix, pos)
Calculates the checksum of a DBCSR matrix.
subroutine, public dbcsr_trace(matrix, trace)
Computes the trace of the given matrix, also known as the sum of its diagonal elements.
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
Basic linear algebra operations for full matrices.
subroutine, public cp_fm_scale_and_add(alpha, matrix_a, beta, matrix_b)
calc A <- alpha*A + beta*B optimized for alpha == 1.0 (just add beta*B) and beta == 0....
represent the structure of a full matrix
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
subroutine, public cp_fm_struct_double(fmstruct, struct, context, col, row)
creates a struct with twice the number of blocks on each core. If matrix A has to be multiplied with ...
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
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
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
subroutine, public cp_fm_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
creates a new full matrix with the given structure
various routines to log and control the output. The idea is that decisions about where to log should ...
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
character(len=default_string_length) function, public cp_iter_string(iter_info, print_key, for_file)
returns the iteration string, a string that is useful to create unique filenames (once you trim it)
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
logical function, public cp_printkey_is_on(iteration_info, print_key)
returns true if the printlevel activates this printkey does not look if this iteration it should be p...
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
A wrapper around pw_to_cube() which accepts particle_list_type.
subroutine, public cp_pw_to_cube(pw, unit_nr, title, particles, zeff, stride, max_file_size_mb, zero_tails, silent, mpi_io)
...
all routins needed for a nonperiodic electric field
subroutine, public make_field(dft_control, field, sim_step, sim_time)
computes the amplitude of the efield within a given envelop
Interface to the Greenx library.
subroutine, public greenx_refine_ft(fit_e_min, fit_e_max, x_fit, y_fit, x_eval, y_eval, n_pade_opt)
Refines the FT grid using Padé approximants.
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public ehrenfest
integer, parameter, public real_time_propagation
objects that represent the structure of input sections and the data contained in an input section
integer function, dimension(:), pointer, public section_get_ivals(section_vals, keyword_name)
...
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
sums arrays of real/complex numbers with much reduced round-off as compared to a naive implementation...
Definition kahan_sum.F:29
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_path_length
Definition kinds.F:58
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:124
Definition of mathematical constants and functions.
real(kind=dp), parameter, public one
real(kind=dp), parameter, public twopi
real(kind=dp), parameter, public zero
Interface to the message passing library MPI.
basic linear algebra operations for full matrixes
represent a simple array based list of the given type
Define methods related to particle_type.
subroutine, public get_particle_set(particle_set, qs_kind_set, first_sgf, last_sgf, nsgf, nmao, basis, ncgf)
Get the components of a particle set.
Define the data structure for the particle information.
Definition of physical constants:
Definition physcon.F:68
real(kind=dp), parameter, public femtoseconds
Definition physcon.F:153
real(kind=dp), parameter, public evolt
Definition physcon.F:183
container for various plainwaves related things
subroutine, public pw_env_get(pw_env, pw_pools, cube_info, gridlevel_info, auxbas_pw_pool, auxbas_grid, auxbas_rs_desc, auxbas_rs_grid, rs_descs, rs_grids, xc_pw_pool, vdw_pw_pool, poisson_env, interp_section)
returns the various attributes of the pw env
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind_set(qs_kind_set, all_potential_present, tnadd_potential_present, gth_potential_present, sgp_potential_present, paw_atom_present, dft_plus_u_atom_present, maxcgf, maxsgf, maxco, maxco_proj, maxgtops, maxlgto, maxlprj, maxnset, maxsgf_set, ncgf, npgf, nset, nsgf, nshell, maxpol, maxlppl, maxlppnl, maxppnl, nelectron, maxder, max_ngrid_rad, max_sph_harm, maxg_iso_not0, lmax_rho0, basis_rcut, basis_type, total_zeff_corr, npgf_seg, cneo_potential_present, nkind_q, natom_q)
Get attributes of an atomic kind set.
given the response wavefunctions obtained by the application of the (rxp), p, and ((dk-dl)xp) operato...
subroutine, public calculate_jrho_resp(mat_d0, mat_jp, mat_jp_rii, mat_jp_riii, ib, idir, current_rs, current_gs, qs_env, current_env, soft_valid, retain_rsgrid)
Calculation of the idir component of the response current density in the presence of a constant magne...
Type definitiona for linear response calculations.
Definition and initialisation of the mo data type.
Definition qs_mo_io.F:21
subroutine, public write_rt_mos_to_restart(mo_array, rt_mos, particle_set, dft_section, qs_kind_set)
...
Definition qs_mo_io.F:246
Calculates the moment integrals <a|r^m|b> and <a|r x d/dr|b>
Definition qs_moments.F:14
subroutine, public build_local_moment_matrix(qs_env, moments, nmoments, ref_point, ref_points, basis_type)
...
Definition qs_moments.F:593
Define the neighbor list data types and the corresponding functionality.
subroutine, public build_lin_mom_matrix(qs_env, matrix)
Calculation of the linear momentum matrix <mu|∂|nu> over Cartesian Gaussian functions.
superstucture that hold various representations of the density and keeps track of which ones are vali...
subroutine, public qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
returns info about the density described by this object. If some representation is not available an e...
Does all kind of post scf calculations for GPW/GAPW.
subroutine, public write_mo_free_results(qs_env)
Write QS results always available (if switched on through the print_keys) Can be called from ls_scf.
subroutine, public qs_scf_post_moments(input, logger, qs_env, output_unit)
Computes and prints electric moments.
subroutine, public write_mo_dependent_results(qs_env, scf_env)
Write QS results available if MO's are present (if switched on through the print_keys) Writes only MO...
Does all kind of post scf calculations for DFTB.
subroutine, public scf_post_calculation_tb(qs_env, tb_type, no_mos)
collects possible post - scf calculations and prints info / computes properties.
module that contains the definitions of the scf types
types that represent a quickstep subsys
subroutine, public qs_subsys_get(subsys, atomic_kinds, atomic_kind_set, particles, particle_set, local_particles, molecules, molecule_set, molecule_kinds, molecule_kind_set, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, natom, nparticle, ncore, nshell, nkind, atprop, virial, results, cell, cell_ref, use_ref_cell, energy, force, qs_kind_set, cp_subsys, nelectron_total, nelectron_spin)
...
Function related to MO projection in RTP calculations.
subroutine, public compute_and_write_proj_mo(qs_env, mos_new, proj_mo, n_proj)
Compute the projection of the current MO coefficients on reference ones and write the results.
Separation of Fourier transform utilities into separate file.
subroutine, public multi_fft(time_series, value_series, result_series, omega_series, damping_opt, t0_opt, subtract_initial_opt)
Calculates the Fourier transform - couples to FFT libraries in CP2K, if available.
Routine for the real time propagation output.
subroutine, public print_ft(rtp_section, moments, times, fields, rtc, info_opt, cell)
Calculate and print the Fourier transforms + polarizabilites from moment trace.
subroutine, public report_density_occupation(filter_eps, rho)
Reports the sparsity pattern of the complex density matrix.
subroutine, public print_rt_file(rt_unit, headers, xvals, yvals, prefix, prefix_format, xscale_opt, comp_opt)
...
subroutine, public rt_prop_output(qs_env, run_type, delta_iter, used_time)
...
subroutine, public print_moments(moments_section, info_unit, moments, time, imag_opt, append_opt)
Print the dipole moments into a file.
subroutine, public rt_convergence(rtp, matrix_s, delta_mos, delta_eps)
computes the convergence criterion for RTP and EMD
integer, parameter, public rt_file_comp_both
subroutine, public calc_local_moment(moment_matrices, density_matrices, work, moment, imag_opt)
Calculate the values of real/imaginary parts of moments in all directions.
integer, parameter, public rt_file_comp_imag
integer, parameter, public rt_file_comp_real
subroutine, public rt_convergence_density(rtp, delta_p, delta_eps)
computes the convergence criterion for RTP and EMD based on the density matrix
Types and set_get for real time propagation depending on runtype and diagonalization method different...
subroutine, public get_rtp(rtp, exp_h_old, exp_h_new, h_last_iter, rho_old, rho_next, rho_new, mos, mos_new, mos_old, mos_next, s_inv, s_half, s_minus_half, b_mat, c_mat, propagator_matrix, mixing, mixing_factor, s_der, dt, nsteps, sinvh, sinvh_imag, sinvb, admm_mos)
...
Routines needed for EMD.
subroutine, public write_rtp_mos_to_output_unit(qs_env, rtp)
...
subroutine, public write_rtp_mo_cubes(qs_env, rtp)
Write the time dependent amplitude of the MOs in real grid. Very close to qs_scf_post_gpw/qs_scf_post...
Provides all information about an atomic kind.
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
keeps the information about the structure of a full matrix
represent a full matrix
type of a logger, at the moment it contains just a print level starting at which level it should be l...
contained for different pw related things
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Provides all information about a quickstep kind.
keeps the density in various representations, keeping track of which ones are valid.