(git:48ec5b0)
Loading...
Searching...
No Matches
qs_scf_post_gpw.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Does all kind of post scf calculations for GPW/GAPW
10!> \par History
11!> Started as a copy from the relevant part of qs_scf
12!> Start to adapt for k-points [07.2015, JGH]
13!> \author Joost VandeVondele (10.2003)
14! **************************************************************************************************
16 USE admm_types, ONLY: admm_type
19 USE ai_onecenter, ONLY: sg_overlap
25 USE cell_types, ONLY: cell_type
29 USE cp_dbcsr_api, ONLY: dbcsr_add,&
35 USE cp_ddapc_util, ONLY: get_ddapc
40 USE cp_fm_types, ONLY: cp_fm_create,&
50 USE cp_output_handling, ONLY: cp_p_file,&
55 USE dct, ONLY: pw_shrink
56 USE ed_analysis, ONLY: edmf_analysis
57 USE eeq_method, ONLY: eeq_print
59 USE hfx_ri, ONLY: print_ri_hfx
70 USE iao_types, ONLY: iao_env_type,&
72 USE input_constants, ONLY: &
83 USE kinds, ONLY: default_path_length,&
85 dp
86 USE kpoint_types, ONLY: kpoint_type
88 USE mathconstants, ONLY: pi
94 USE mulliken, ONLY: mulliken_charges
95 USE orbital_pointers, ONLY: indso
98 USE physcon, ONLY: angstrom,&
99 evolt
103 USE ps_implicit_types, ONLY: mixed_bc,&
105 neumann_bc,&
107 USE pw_env_types, ONLY: pw_env_get,&
109 USE pw_grids, ONLY: get_pw_grid_info
110 USE pw_methods, ONLY: pw_axpy,&
111 pw_copy,&
112 pw_derive,&
114 pw_scale,&
116 pw_zero
120 USE pw_pool_types, ONLY: pw_pool_p_type,&
122 USE pw_types, ONLY: pw_c1d_gs_type,&
124 USE qs_chargemol, ONLY: write_wfx
129 USE qs_dos, ONLY: calculate_dos,&
132 USE qs_elf_methods, ONLY: qs_elf_calc
138 USE qs_epr_hyp, ONLY: qs_epr_hyp_calc
141 USE qs_kind_types, ONLY: get_qs_kind,&
146 USE qs_loc_dipole, ONLY: loc_dipole
162 USE qs_mo_types, ONLY: get_mo_set,&
175 USE qs_resp, ONLY: resp_fit
176 USE qs_rho0_types, ONLY: get_rho0_mpole,&
181 USE qs_rho_types, ONLY: qs_rho_get,&
186 USE qs_scf_types, ONLY: ot_method_nr,&
188 USE qs_scf_wfn_mix, ONLY: wfn_mix
189 USE qs_subsys_types, ONLY: qs_subsys_get,&
194 USE stm_images, ONLY: th_stm_image
196 USE trexio_utils, ONLY: write_trexio
197 USE virial_types, ONLY: virial_type
201#include "./base/base_uses.f90"
202
203 IMPLICIT NONE
204 PRIVATE
205
206 ! Global parameters
207 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_scf_post_gpw'
208 PUBLIC :: scf_post_calculation_gpw, &
212
213 PUBLIC :: make_lumo_gpw
214
215! **************************************************************************************************
216
217CONTAINS
218
219! **************************************************************************************************
220!> \brief collects possible post - scf calculations and prints info / computes properties.
221!> \param qs_env the qs_env in which the qs_env lives
222!> \param wf_type ...
223!> \param do_mp2 ...
224!> \par History
225!> 02.2003 created [fawzi]
226!> 10.2004 moved here from qs_scf [Joost VandeVondele]
227!> started splitting out different subroutines
228!> 10.2015 added header for wave-function correlated methods [Vladimir Rybkin]
229!> \author fawzi
230!> \note
231!> this function changes mo_eigenvectors and mo_eigenvalues, depending on the print keys.
232!> In particular, MO_CUBES causes the MOs to be rotated to make them eigenstates of the KS
233!> matrix, and mo_eigenvalues is updated accordingly. This can, for unconverged wavefunctions,
234!> change afterwards slightly the forces (hence small numerical differences between MD
235!> with and without the debug print level). Ideally this should not happen...
236! **************************************************************************************************
237 SUBROUTINE scf_post_calculation_gpw(qs_env, wf_type, do_mp2)
238
239 TYPE(qs_environment_type), POINTER :: qs_env
240 CHARACTER(6), OPTIONAL :: wf_type
241 LOGICAL, OPTIONAL :: do_mp2
242
243 CHARACTER(len=*), PARAMETER :: routinen = 'scf_post_calculation_gpw'
244
245 INTEGER :: handle, homo, ispin, min_lumos, n_rep, &
246 nchk_nmoloc, nhomo, nlumo, nlumo_stm, &
247 nlumos, nmo, nspins, output_unit, &
248 unit_nr
249 INTEGER, DIMENSION(:, :, :), POINTER :: marked_states
250 LOGICAL :: check_write, compute_lumos, do_homo, do_kpoints, do_mixed, do_mo_cubes, do_stm, &
251 do_wannier_cubes, has_homo, has_lumo, loc_explicit, loc_print_explicit, my_do_mp2, &
252 my_localized_wfn, p_loc, p_loc_homo, p_loc_lumo, p_loc_mixed
253 REAL(dp) :: e_kin
254 REAL(kind=dp) :: gap, homo_lumo(2, 2), total_zeff_corr
255 REAL(kind=dp), DIMENSION(:), POINTER :: mo_eigenvalues
256 TYPE(admm_type), POINTER :: admm_env
257 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
258 TYPE(cp_1d_r_p_type), DIMENSION(:), POINTER :: mixed_evals, occupied_evals, &
259 unoccupied_evals, unoccupied_evals_stm
260 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: mixed_orbs, occupied_orbs
261 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:), &
262 TARGET :: homo_localized, lumo_localized, &
263 mixed_localized
264 TYPE(cp_fm_type), DIMENSION(:), POINTER :: lumo_ptr, mo_loc_history, &
265 unoccupied_orbs, unoccupied_orbs_stm
266 TYPE(cp_fm_type), POINTER :: mo_coeff
267 TYPE(cp_logger_type), POINTER :: logger
268 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_rmpv, matrix_p_mp2, matrix_s, &
269 mo_derivs
270 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: kinetic_m, rho_ao
271 TYPE(dft_control_type), POINTER :: dft_control
272 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
273 TYPE(molecule_type), POINTER :: molecule_set(:)
274 TYPE(mp_para_env_type), POINTER :: para_env
275 TYPE(particle_list_type), POINTER :: particles
276 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
277 TYPE(pw_c1d_gs_type) :: wf_g
278 TYPE(pw_env_type), POINTER :: pw_env
279 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
280 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
281 TYPE(pw_r3d_rs_type) :: wf_r
282 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
283 TYPE(qs_loc_env_type), POINTER :: qs_loc_env_homo, qs_loc_env_lumo, &
284 qs_loc_env_mixed
285 TYPE(qs_rho_type), POINTER :: rho
286 TYPE(qs_scf_env_type), POINTER :: scf_env
287 TYPE(qs_subsys_type), POINTER :: subsys
288 TYPE(scf_control_type), POINTER :: scf_control
289 TYPE(section_vals_type), POINTER :: dft_section, input, loc_print_section, &
290 localize_section, print_key, &
291 stm_section
292
293 CALL timeset(routinen, handle)
294
295 logger => cp_get_default_logger()
296 output_unit = cp_logger_get_default_io_unit(logger)
297
298 ! Print out the type of wavefunction to distinguish between SCF and post-SCF
299 my_do_mp2 = .false.
300 IF (PRESENT(do_mp2)) my_do_mp2 = do_mp2
301 IF (PRESENT(wf_type)) THEN
302 IF (output_unit > 0) THEN
303 WRITE (unit=output_unit, fmt='(/,(T1,A))') repeat("-", 40)
304 WRITE (unit=output_unit, fmt='(/,(T3,A,T19,A,T25,A))') "Properties from ", wf_type, " density"
305 WRITE (unit=output_unit, fmt='(/,(T1,A))') repeat("-", 40)
306 END IF
307 END IF
308
309 ! Writes the data that is already available in qs_env
310 CALL get_qs_env(qs_env, scf_env=scf_env)
311
312 my_localized_wfn = .false.
313 NULLIFY (admm_env, dft_control, pw_env, auxbas_pw_pool, pw_pools, mos, rho, &
314 mo_coeff, ks_rmpv, matrix_s, qs_loc_env_homo, qs_loc_env_lumo, scf_control, &
315 unoccupied_orbs, mo_eigenvalues, unoccupied_evals, &
316 unoccupied_evals_stm, molecule_set, mo_derivs, &
317 subsys, particles, input, print_key, kinetic_m, marked_states, &
318 mixed_evals, qs_loc_env_mixed)
319 NULLIFY (lumo_ptr, rho_ao)
320
321 has_homo = .false.
322 has_lumo = .false.
323 p_loc = .false.
324 p_loc_homo = .false.
325 p_loc_lumo = .false.
326 p_loc_mixed = .false.
327
328 cpassert(ASSOCIATED(scf_env))
329 cpassert(ASSOCIATED(qs_env))
330 ! Here we start with data that needs a postprocessing...
331 CALL get_qs_env(qs_env, &
332 dft_control=dft_control, &
333 molecule_set=molecule_set, &
334 scf_control=scf_control, &
335 do_kpoints=do_kpoints, &
336 input=input, &
337 subsys=subsys, &
338 rho=rho, &
339 pw_env=pw_env, &
340 particle_set=particle_set, &
341 atomic_kind_set=atomic_kind_set, &
342 qs_kind_set=qs_kind_set)
343 CALL qs_subsys_get(subsys, particles=particles)
344
345 CALL qs_rho_get(rho, rho_ao_kp=rho_ao)
346
347 IF (my_do_mp2) THEN
348 ! Get the HF+MP2 density
349 CALL get_qs_env(qs_env, matrix_p_mp2=matrix_p_mp2)
350 DO ispin = 1, dft_control%nspins
351 CALL dbcsr_add(rho_ao(ispin, 1)%matrix, matrix_p_mp2(ispin)%matrix, 1.0_dp, 1.0_dp)
352 END DO
353 CALL qs_rho_update_rho(rho, qs_env=qs_env)
354 CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.true.)
355 ! In MP2 case update the Hartree potential
356 CALL update_hartree_with_mp2(rho, qs_env)
357 END IF
358
359 CALL write_available_results(qs_env, scf_env)
360
361 ! **** the kinetic energy
362 IF (cp_print_key_should_output(logger%iter_info, input, &
363 "DFT%PRINT%KINETIC_ENERGY") /= 0) THEN
364 CALL get_qs_env(qs_env, kinetic_kp=kinetic_m)
365 cpassert(ASSOCIATED(kinetic_m))
366 cpassert(ASSOCIATED(kinetic_m(1, 1)%matrix))
367 CALL calculate_ptrace(kinetic_m, rho_ao, e_kin, dft_control%nspins)
368 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%KINETIC_ENERGY", &
369 extension=".Log")
370 IF (unit_nr > 0) THEN
371 WRITE (unit_nr, '(T3,A,T55,F25.14)') "Electronic kinetic energy:", e_kin
372 END IF
373 CALL cp_print_key_finished_output(unit_nr, logger, input, &
374 "DFT%PRINT%KINETIC_ENERGY")
375 END IF
376
377 ! Atomic Charges that require further computation
378 CALL qs_scf_post_charges(input, logger, qs_env)
379
380 ! Moments of charge distribution
381 CALL qs_scf_post_moments(input, logger, qs_env, output_unit)
382
383 ! Determine if we need to computer properties using the localized centers
384 dft_section => section_vals_get_subs_vals(input, "DFT")
385 localize_section => section_vals_get_subs_vals(dft_section, "LOCALIZE")
386 loc_print_section => section_vals_get_subs_vals(localize_section, "PRINT")
387 CALL section_vals_get(localize_section, explicit=loc_explicit)
388 CALL section_vals_get(loc_print_section, explicit=loc_print_explicit)
389
390 ! Print_keys controlled by localization
391 IF (loc_print_explicit) THEN
392 print_key => section_vals_get_subs_vals(loc_print_section, "MOLECULAR_DIPOLES")
393 p_loc = btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
394 print_key => section_vals_get_subs_vals(loc_print_section, "TOTAL_DIPOLE")
395 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
396 print_key => section_vals_get_subs_vals(loc_print_section, "WANNIER_CENTERS")
397 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
398 print_key => section_vals_get_subs_vals(loc_print_section, "WANNIER_SPREADS")
399 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
400 print_key => section_vals_get_subs_vals(loc_print_section, "WANNIER_CUBES")
401 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
402 print_key => section_vals_get_subs_vals(loc_print_section, "MOLECULAR_STATES")
403 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
404 print_key => section_vals_get_subs_vals(loc_print_section, "MOLECULAR_MOMENTS")
405 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
406 print_key => section_vals_get_subs_vals(loc_print_section, "WANNIER_STATES")
407 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
408 ELSE
409 p_loc = .false.
410 END IF
411 IF (loc_explicit) THEN
412 p_loc_homo = (section_get_ival(localize_section, "STATES") == do_loc_homo .OR. &
413 section_get_ival(localize_section, "STATES") == do_loc_both) .AND. p_loc
414 p_loc_lumo = (section_get_ival(localize_section, "STATES") == do_loc_lumo .OR. &
415 section_get_ival(localize_section, "STATES") == do_loc_both) .AND. p_loc
416 p_loc_mixed = (section_get_ival(localize_section, "STATES") == do_loc_mixed) .AND. p_loc
417 CALL section_vals_val_get(localize_section, "LIST_UNOCCUPIED", n_rep_val=n_rep)
418 ELSE
419 p_loc_homo = .false.
420 p_loc_lumo = .false.
421 p_loc_mixed = .false.
422 n_rep = 0
423 END IF
424
425 IF (n_rep == 0 .AND. p_loc_lumo) THEN
426 CALL cp_abort(__location__, "No LIST_UNOCCUPIED was specified, "// &
427 "therefore localization of unoccupied states will be skipped!")
428 p_loc_lumo = .false.
429 END IF
430
431 ! Control for STM
432 stm_section => section_vals_get_subs_vals(input, "DFT%PRINT%STM")
433 CALL section_vals_get(stm_section, explicit=do_stm)
434 nlumo_stm = 0
435 IF (do_stm) nlumo_stm = section_get_ival(stm_section, "NLUMO")
436
437 ! check for CUBES (MOs and WANNIERS)
438 do_mo_cubes = btest(cp_print_key_should_output(logger%iter_info, dft_section, "PRINT%MO_CUBES") &
439 , cp_p_file)
440 IF (loc_print_explicit) THEN
441 do_wannier_cubes = btest(cp_print_key_should_output(logger%iter_info, loc_print_section, &
442 "WANNIER_CUBES"), cp_p_file)
443 ELSE
444 do_wannier_cubes = .false.
445 END IF
446 nlumo = section_get_ival(dft_section, "PRINT%MO_CUBES%NLUMO")
447 nhomo = section_get_ival(dft_section, "PRINT%MO_CUBES%NHOMO")
448
449 ! Setup the grids needed to compute a wavefunction given a vector..
450 IF (((do_mo_cubes .OR. do_wannier_cubes) .AND. (nlumo /= 0 .OR. nhomo /= 0)) .OR. p_loc) THEN
451 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
452 pw_pools=pw_pools)
453 CALL auxbas_pw_pool%create_pw(wf_r)
454 CALL auxbas_pw_pool%create_pw(wf_g)
455 END IF
456
457 IF (dft_control%restricted) THEN
458 !For ROKS usefull only first term
459 nspins = 1
460 ELSE
461 nspins = dft_control%nspins
462 END IF
463 !Some info about ROKS
464 IF (dft_control%restricted .AND. (do_mo_cubes .OR. p_loc_homo)) THEN
465 CALL cp_abort(__location__, "Unclear how we define MOs / localization in the restricted case ... ")
466 ! It is possible to obtain Wannier centers for ROKS without rotations for SINGLE OCCUPIED ORBITALS
467 END IF
468 ! Makes the MOs eigenstates, computes eigenvalues, write cubes
469 IF (do_kpoints) THEN
470 cpwarn_if(do_mo_cubes, "Print MO cubes not implemented for k-point calculations")
471 ELSE
472 CALL get_qs_env(qs_env, &
473 mos=mos, &
474 matrix_ks=ks_rmpv)
475 IF ((do_mo_cubes .AND. nhomo /= 0) .OR. do_stm) THEN
476 CALL get_qs_env(qs_env, mo_derivs=mo_derivs)
477 IF (dft_control%do_admm) THEN
478 CALL get_qs_env(qs_env, admm_env=admm_env)
479 CALL make_mo_eig(mos, nspins, ks_rmpv, scf_control, mo_derivs, admm_env=admm_env)
480 ELSE
481 IF (dft_control%hairy_probes) THEN
482 scf_control%smear%do_smear = .false.
483 CALL make_mo_eig(mos, dft_control%nspins, ks_rmpv, scf_control, mo_derivs, &
484 hairy_probes=dft_control%hairy_probes, &
485 probe=dft_control%probe)
486 ELSE
487 CALL make_mo_eig(mos, dft_control%nspins, ks_rmpv, scf_control, mo_derivs)
488 END IF
489 END IF
490 DO ispin = 1, dft_control%nspins
491 CALL get_mo_set(mo_set=mos(ispin), eigenvalues=mo_eigenvalues, homo=homo)
492 homo_lumo(ispin, 1) = mo_eigenvalues(homo)
493 END DO
494 has_homo = .true.
495 END IF
496 IF (do_mo_cubes .AND. nhomo /= 0) THEN
497 DO ispin = 1, nspins
498 ! Prints the cube files of OCCUPIED ORBITALS
499 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, &
500 eigenvalues=mo_eigenvalues, homo=homo, nmo=nmo)
501 CALL qs_scf_post_occ_cubes(input, dft_section, dft_control, logger, qs_env, &
502 mo_coeff, wf_g, wf_r, particles, homo, ispin)
503 END DO
504 END IF
505 END IF
506
507 ! Initialize the localization environment, needed e.g. for wannier functions and molecular states
508 ! Gets localization info for the occupied orbs
509 ! - Possibly gets wannier functions
510 ! - Possibly gets molecular states
511 IF (p_loc_homo) THEN
512 IF (do_kpoints) THEN
513 cpwarn("Localization not implemented for k-point calculations!")
514 ELSEIF (dft_control%restricted &
515 .AND. (section_get_ival(localize_section, "METHOD") .NE. do_loc_none) &
516 .AND. (section_get_ival(localize_section, "METHOD") .NE. do_loc_jacobi)) THEN
517 cpabort("ROKS works only with LOCALIZE METHOD NONE or JACOBI")
518 ELSE
519 ALLOCATE (occupied_orbs(dft_control%nspins))
520 ALLOCATE (occupied_evals(dft_control%nspins))
521 ALLOCATE (homo_localized(dft_control%nspins))
522 DO ispin = 1, dft_control%nspins
523 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, &
524 eigenvalues=mo_eigenvalues)
525 occupied_orbs(ispin) = mo_coeff
526 occupied_evals(ispin)%array => mo_eigenvalues
527 CALL cp_fm_create(homo_localized(ispin), occupied_orbs(ispin)%matrix_struct)
528 CALL cp_fm_to_fm(occupied_orbs(ispin), homo_localized(ispin))
529 END DO
530
531 CALL get_qs_env(qs_env, mo_loc_history=mo_loc_history)
532 do_homo = .true.
533
534 ALLOCATE (qs_loc_env_homo)
535 CALL qs_loc_env_create(qs_loc_env_homo)
536 CALL qs_loc_control_init(qs_loc_env_homo, localize_section, do_homo=do_homo)
537 CALL qs_loc_init(qs_env, qs_loc_env_homo, localize_section, homo_localized, do_homo, &
538 do_mo_cubes, mo_loc_history=mo_loc_history)
539 CALL get_localization_info(qs_env, qs_loc_env_homo, localize_section, homo_localized, &
540 wf_r, wf_g, particles, occupied_orbs, occupied_evals, marked_states)
541
542 !retain the homo_localized for future use
543 IF (qs_loc_env_homo%localized_wfn_control%use_history) THEN
544 CALL retain_history(mo_loc_history, homo_localized)
545 CALL set_qs_env(qs_env, mo_loc_history=mo_loc_history)
546 END IF
547
548 !write restart for localization of occupied orbitals
549 CALL loc_write_restart(qs_loc_env_homo, loc_print_section, mos, &
550 homo_localized, do_homo)
551 CALL cp_fm_release(homo_localized)
552 DEALLOCATE (occupied_orbs)
553 DEALLOCATE (occupied_evals)
554 ! Print Total Dipole if the localization has been performed
555 IF (qs_loc_env_homo%do_localize) THEN
556 CALL loc_dipole(input, dft_control, qs_loc_env_homo, logger, qs_env)
557 END IF
558 END IF
559 END IF
560
561 ! Gets the lumos, and eigenvalues for the lumos, and localize them if requested
562 IF (do_kpoints) THEN
563 IF (do_mo_cubes .OR. p_loc_lumo) THEN
564 ! nothing at the moment, not implemented
565 cpwarn("Localization and MO related output not implemented for k-point calculations!")
566 END IF
567 ELSE
568 compute_lumos = do_mo_cubes .AND. nlumo .NE. 0
569 compute_lumos = compute_lumos .OR. p_loc_lumo
570
571 DO ispin = 1, dft_control%nspins
572 CALL get_mo_set(mo_set=mos(ispin), homo=homo, nmo=nmo)
573 compute_lumos = compute_lumos .AND. homo == nmo
574 END DO
575
576 IF (do_mo_cubes .AND. .NOT. compute_lumos) THEN
577
578 nlumo = section_get_ival(dft_section, "PRINT%MO_CUBES%NLUMO")
579 DO ispin = 1, dft_control%nspins
580
581 CALL get_mo_set(mo_set=mos(ispin), homo=homo, nmo=nmo, eigenvalues=mo_eigenvalues)
582 IF (nlumo > nmo - homo) THEN
583 ! this case not yet implemented
584 ELSE
585 IF (nlumo .EQ. -1) THEN
586 nlumo = nmo - homo
587 END IF
588 IF (output_unit > 0) WRITE (output_unit, *) " "
589 IF (output_unit > 0) WRITE (output_unit, *) " Lowest eigenvalues of the unoccupied subspace spin ", ispin
590 IF (output_unit > 0) WRITE (output_unit, *) "---------------------------------------------"
591 IF (output_unit > 0) WRITE (output_unit, '(4(1X,1F16.8))') mo_eigenvalues(homo + 1:homo + nlumo)
592
593 ! Prints the cube files of UNOCCUPIED ORBITALS
594 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff)
595 CALL qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_env, &
596 mo_coeff, wf_g, wf_r, particles, nlumo, homo, ispin, lumo=homo + 1)
597 END IF
598 END DO
599
600 END IF
601
602 IF (compute_lumos) THEN
603 check_write = .true.
604 min_lumos = nlumo
605 IF (nlumo == 0) check_write = .false.
606 IF (p_loc_lumo) THEN
607 do_homo = .false.
608 ALLOCATE (qs_loc_env_lumo)
609 CALL qs_loc_env_create(qs_loc_env_lumo)
610 CALL qs_loc_control_init(qs_loc_env_lumo, localize_section, do_homo=do_homo)
611 min_lumos = max(maxval(qs_loc_env_lumo%localized_wfn_control%loc_states(:, :)), nlumo)
612 END IF
613
614 ALLOCATE (unoccupied_orbs(dft_control%nspins))
615 ALLOCATE (unoccupied_evals(dft_control%nspins))
616 CALL make_lumo_gpw(qs_env, scf_env, unoccupied_orbs, unoccupied_evals, min_lumos, nlumos)
617 lumo_ptr => unoccupied_orbs
618 DO ispin = 1, dft_control%nspins
619 has_lumo = .true.
620 homo_lumo(ispin, 2) = unoccupied_evals(ispin)%array(1)
621 CALL get_mo_set(mo_set=mos(ispin), homo=homo)
622 IF (check_write) THEN
623 IF (p_loc_lumo .AND. nlumo .NE. -1) nlumos = min(nlumo, nlumos)
624 ! Prints the cube files of UNOCCUPIED ORBITALS
625 CALL qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_env, &
626 unoccupied_orbs(ispin), wf_g, wf_r, particles, nlumos, homo, ispin)
627 END IF
628 END DO
629
630 IF (p_loc_lumo) THEN
631 ALLOCATE (lumo_localized(dft_control%nspins))
632 DO ispin = 1, dft_control%nspins
633 CALL cp_fm_create(lumo_localized(ispin), unoccupied_orbs(ispin)%matrix_struct)
634 CALL cp_fm_to_fm(unoccupied_orbs(ispin), lumo_localized(ispin))
635 END DO
636 CALL qs_loc_init(qs_env, qs_loc_env_lumo, localize_section, lumo_localized, do_homo, do_mo_cubes, &
637 evals=unoccupied_evals)
638 CALL qs_loc_env_init(qs_loc_env_lumo, qs_loc_env_lumo%localized_wfn_control, qs_env, &
639 loc_coeff=unoccupied_orbs)
640 CALL get_localization_info(qs_env, qs_loc_env_lumo, localize_section, &
641 lumo_localized, wf_r, wf_g, particles, &
642 unoccupied_orbs, unoccupied_evals, marked_states)
643 CALL loc_write_restart(qs_loc_env_lumo, loc_print_section, mos, homo_localized, do_homo, &
644 evals=unoccupied_evals)
645 lumo_ptr => lumo_localized
646 END IF
647 END IF
648
649 IF (has_homo .AND. has_lumo) THEN
650 IF (output_unit > 0) WRITE (output_unit, *) " "
651 DO ispin = 1, dft_control%nspins
652 IF (.NOT. scf_control%smear%do_smear) THEN
653 gap = homo_lumo(ispin, 2) - homo_lumo(ispin, 1)
654 IF (output_unit > 0) WRITE (output_unit, '(T2,A,F12.6)') &
655 "HOMO - LUMO gap [eV] :", gap*evolt
656 END IF
657 END DO
658 END IF
659 END IF
660
661 IF (p_loc_mixed) THEN
662 IF (do_kpoints) THEN
663 cpwarn("Localization not implemented for k-point calculations!")
664 ELSEIF (dft_control%restricted) THEN
665 IF (output_unit > 0) WRITE (output_unit, *) &
666 " Unclear how we define MOs / localization in the restricted case... skipping"
667 ELSE
668
669 ALLOCATE (mixed_orbs(dft_control%nspins))
670 ALLOCATE (mixed_evals(dft_control%nspins))
671 ALLOCATE (mixed_localized(dft_control%nspins))
672 DO ispin = 1, dft_control%nspins
673 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, &
674 eigenvalues=mo_eigenvalues)
675 mixed_orbs(ispin) = mo_coeff
676 mixed_evals(ispin)%array => mo_eigenvalues
677 CALL cp_fm_create(mixed_localized(ispin), mixed_orbs(ispin)%matrix_struct)
678 CALL cp_fm_to_fm(mixed_orbs(ispin), mixed_localized(ispin))
679 END DO
680
681 CALL get_qs_env(qs_env, mo_loc_history=mo_loc_history)
682 do_homo = .false.
683 do_mixed = .true.
684 total_zeff_corr = scf_env%sum_zeff_corr
685 ALLOCATE (qs_loc_env_mixed)
686 CALL qs_loc_env_create(qs_loc_env_mixed)
687 CALL qs_loc_control_init(qs_loc_env_mixed, localize_section, do_homo=do_homo, do_mixed=do_mixed)
688 CALL qs_loc_init(qs_env, qs_loc_env_mixed, localize_section, mixed_localized, do_homo, &
689 do_mo_cubes, mo_loc_history=mo_loc_history, tot_zeff_corr=total_zeff_corr, &
691
692 DO ispin = 1, dft_control%nspins
693 CALL cp_fm_get_info(mixed_localized(ispin), ncol_global=nchk_nmoloc)
694 END DO
695
696 CALL get_localization_info(qs_env, qs_loc_env_mixed, localize_section, mixed_localized, &
697 wf_r, wf_g, particles, mixed_orbs, mixed_evals, marked_states)
698
699 !retain the homo_localized for future use
700 IF (qs_loc_env_mixed%localized_wfn_control%use_history) THEN
701 CALL retain_history(mo_loc_history, mixed_localized)
702 CALL set_qs_env(qs_env, mo_loc_history=mo_loc_history)
703 END IF
704
705 !write restart for localization of occupied orbitals
706 CALL loc_write_restart(qs_loc_env_mixed, loc_print_section, mos, &
707 mixed_localized, do_homo, do_mixed=do_mixed)
708 CALL cp_fm_release(mixed_localized)
709 DEALLOCATE (mixed_orbs)
710 DEALLOCATE (mixed_evals)
711 ! Print Total Dipole if the localization has been performed
712! Revisit the formalism later
713 !IF (qs_loc_env_mixed%do_localize) THEN
714 ! CALL loc_dipole(input, dft_control, qs_loc_env_mixed, logger, qs_env)
715 !END IF
716 END IF
717 END IF
718
719 ! Deallocate grids needed to compute wavefunctions
720 IF (((do_mo_cubes .OR. do_wannier_cubes) .AND. (nlumo /= 0 .OR. nhomo /= 0)) .OR. p_loc) THEN
721 CALL auxbas_pw_pool%give_back_pw(wf_r)
722 CALL auxbas_pw_pool%give_back_pw(wf_g)
723 END IF
724
725 ! Destroy the localization environment
726 IF (.NOT. do_kpoints) THEN
727 IF (p_loc_homo) THEN
728 CALL qs_loc_env_release(qs_loc_env_homo)
729 DEALLOCATE (qs_loc_env_homo)
730 END IF
731 IF (p_loc_lumo) THEN
732 CALL qs_loc_env_release(qs_loc_env_lumo)
733 DEALLOCATE (qs_loc_env_lumo)
734 END IF
735 IF (p_loc_mixed) THEN
736 CALL qs_loc_env_release(qs_loc_env_mixed)
737 DEALLOCATE (qs_loc_env_mixed)
738 END IF
739 END IF
740
741 ! generate a mix of wfns, and write to a restart
742 IF (do_kpoints) THEN
743 ! nothing at the moment, not implemented
744 ELSE
745 CALL get_qs_env(qs_env, matrix_s=matrix_s, para_env=para_env)
746 CALL wfn_mix(mos, particle_set, dft_section, qs_kind_set, para_env, &
747 output_unit, unoccupied_orbs=lumo_ptr, scf_env=scf_env, &
748 matrix_s=matrix_s, marked_states=marked_states)
749
750 IF (p_loc_lumo) CALL cp_fm_release(lumo_localized)
751 END IF
752 IF (ASSOCIATED(marked_states)) THEN
753 DEALLOCATE (marked_states)
754 END IF
755
756 ! This is just a deallocation for printing MO_CUBES or TDDFPT
757 IF (.NOT. do_kpoints) THEN
758 IF (compute_lumos) THEN
759 DO ispin = 1, dft_control%nspins
760 DEALLOCATE (unoccupied_evals(ispin)%array)
761 CALL cp_fm_release(unoccupied_orbs(ispin))
762 END DO
763 DEALLOCATE (unoccupied_evals)
764 DEALLOCATE (unoccupied_orbs)
765 END IF
766 END IF
767
768 !stm images
769 IF (do_stm) THEN
770 IF (do_kpoints) THEN
771 cpwarn("STM not implemented for k-point calculations!")
772 ELSE
773 NULLIFY (unoccupied_orbs_stm, unoccupied_evals_stm)
774 IF (nlumo_stm > 0) THEN
775 ALLOCATE (unoccupied_orbs_stm(dft_control%nspins))
776 ALLOCATE (unoccupied_evals_stm(dft_control%nspins))
777 CALL make_lumo_gpw(qs_env, scf_env, unoccupied_orbs_stm, unoccupied_evals_stm, &
778 nlumo_stm, nlumos)
779 END IF
780
781 CALL th_stm_image(qs_env, stm_section, particles, unoccupied_orbs_stm, &
782 unoccupied_evals_stm)
783
784 IF (nlumo_stm > 0) THEN
785 DO ispin = 1, dft_control%nspins
786 DEALLOCATE (unoccupied_evals_stm(ispin)%array)
787 END DO
788 DEALLOCATE (unoccupied_evals_stm)
789 CALL cp_fm_release(unoccupied_orbs_stm)
790 END IF
791 END IF
792 END IF
793
794 ! Print coherent X-ray diffraction spectrum
795 CALL qs_scf_post_xray(input, dft_section, logger, qs_env, output_unit)
796
797 ! Calculation of Electric Field Gradients
798 CALL qs_scf_post_efg(input, logger, qs_env)
799
800 ! Calculation of ET
801 CALL qs_scf_post_et(input, qs_env, dft_control)
802
803 ! Calculation of EPR Hyperfine Coupling Tensors
804 CALL qs_scf_post_epr(input, logger, qs_env)
805
806 ! Calculation of properties needed for BASIS_MOLOPT optimizations
807 CALL qs_scf_post_molopt(input, logger, qs_env)
808
809 ! Calculate ELF
810 CALL qs_scf_post_elf(input, logger, qs_env)
811
812 ! Use Wannier90 interface
813 CALL wannier90_interface(input, logger, qs_env)
814
815 IF (my_do_mp2) THEN
816 ! Get everything back
817 DO ispin = 1, dft_control%nspins
818 CALL dbcsr_add(rho_ao(ispin, 1)%matrix, matrix_p_mp2(ispin)%matrix, 1.0_dp, -1.0_dp)
819 END DO
820 CALL qs_rho_update_rho(rho, qs_env=qs_env)
821 CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.true.)
822 END IF
823
824 CALL timestop(handle)
825
826 END SUBROUTINE scf_post_calculation_gpw
827
828! **************************************************************************************************
829!> \brief Gets the lumos, and eigenvalues for the lumos
830!> \param qs_env ...
831!> \param scf_env ...
832!> \param unoccupied_orbs ...
833!> \param unoccupied_evals ...
834!> \param nlumo ...
835!> \param nlumos ...
836! **************************************************************************************************
837 SUBROUTINE make_lumo_gpw(qs_env, scf_env, unoccupied_orbs, unoccupied_evals, nlumo, nlumos)
838
839 TYPE(qs_environment_type), POINTER :: qs_env
840 TYPE(qs_scf_env_type), POINTER :: scf_env
841 TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: unoccupied_orbs
842 TYPE(cp_1d_r_p_type), DIMENSION(:), POINTER :: unoccupied_evals
843 INTEGER, INTENT(IN) :: nlumo
844 INTEGER, INTENT(OUT) :: nlumos
845
846 CHARACTER(len=*), PARAMETER :: routinen = 'make_lumo_gpw'
847
848 INTEGER :: handle, homo, ispin, n, nao, nmo, &
849 output_unit
850 TYPE(admm_type), POINTER :: admm_env
851 TYPE(cp_blacs_env_type), POINTER :: blacs_env
852 TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
853 TYPE(cp_fm_type), POINTER :: mo_coeff
854 TYPE(cp_logger_type), POINTER :: logger
855 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_rmpv, matrix_s
856 TYPE(dft_control_type), POINTER :: dft_control
857 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
858 TYPE(mp_para_env_type), POINTER :: para_env
859 TYPE(preconditioner_type), POINTER :: local_preconditioner
860 TYPE(scf_control_type), POINTER :: scf_control
861
862 CALL timeset(routinen, handle)
863
864 NULLIFY (mos, ks_rmpv, scf_control, dft_control, admm_env, para_env, blacs_env)
865 CALL get_qs_env(qs_env, &
866 mos=mos, &
867 matrix_ks=ks_rmpv, &
868 scf_control=scf_control, &
869 dft_control=dft_control, &
870 matrix_s=matrix_s, &
871 admm_env=admm_env, &
872 para_env=para_env, &
873 blacs_env=blacs_env)
874
875 logger => cp_get_default_logger()
876 output_unit = cp_logger_get_default_io_unit(logger)
877
878 DO ispin = 1, dft_control%nspins
879 NULLIFY (unoccupied_evals(ispin)%array)
880 ! Always write eigenvalues
881 IF (output_unit > 0) WRITE (output_unit, *) " "
882 IF (output_unit > 0) WRITE (output_unit, *) " Lowest Eigenvalues of the unoccupied subspace spin ", ispin
883 IF (output_unit > 0) WRITE (output_unit, fmt='(1X,A)') "-----------------------------------------------------"
884 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, homo=homo, nao=nao, nmo=nmo)
885 CALL cp_fm_get_info(mo_coeff, nrow_global=n)
886 nlumos = max(1, min(nlumo, nao - nmo))
887 IF (nlumo == -1) nlumos = nao - nmo
888 ALLOCATE (unoccupied_evals(ispin)%array(nlumos))
889 CALL cp_fm_struct_create(fm_struct_tmp, para_env=para_env, context=blacs_env, &
890 nrow_global=n, ncol_global=nlumos)
891 CALL cp_fm_create(unoccupied_orbs(ispin), fm_struct_tmp, name="lumos")
892 CALL cp_fm_struct_release(fm_struct_tmp)
893 CALL cp_fm_init_random(unoccupied_orbs(ispin), nlumos)
894
895 ! the full_all preconditioner makes not much sense for lumos search
896 NULLIFY (local_preconditioner)
897 IF (ASSOCIATED(scf_env%ot_preconditioner)) THEN
898 local_preconditioner => scf_env%ot_preconditioner(1)%preconditioner
899 ! this one can for sure not be right (as it has to match a given C0)
900 IF (local_preconditioner%in_use == ot_precond_full_all) THEN
901 NULLIFY (local_preconditioner)
902 END IF
903 END IF
904
905 ! If we do ADMM, we add have to modify the Kohn-Sham matrix
906 IF (dft_control%do_admm) THEN
907 CALL admm_correct_for_eigenvalues(ispin, admm_env, ks_rmpv(ispin)%matrix)
908 END IF
909
910 CALL ot_eigensolver(matrix_h=ks_rmpv(ispin)%matrix, matrix_s=matrix_s(1)%matrix, &
911 matrix_c_fm=unoccupied_orbs(ispin), &
912 matrix_orthogonal_space_fm=mo_coeff, &
913 eps_gradient=scf_control%eps_lumos, &
914 preconditioner=local_preconditioner, &
915 iter_max=scf_control%max_iter_lumos, &
916 size_ortho_space=nmo)
917
918 CALL calculate_subspace_eigenvalues(unoccupied_orbs(ispin), ks_rmpv(ispin)%matrix, &
919 unoccupied_evals(ispin)%array, scr=output_unit, &
920 ionode=output_unit > 0)
921
922 ! If we do ADMM, we restore the original Kohn-Sham matrix
923 IF (dft_control%do_admm) THEN
924 CALL admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_rmpv(ispin)%matrix)
925 END IF
926
927 END DO
928
929 CALL timestop(handle)
930
931 END SUBROUTINE make_lumo_gpw
932! **************************************************************************************************
933!> \brief Computes and Prints Atomic Charges with several methods
934!> \param input ...
935!> \param logger ...
936!> \param qs_env the qs_env in which the qs_env lives
937! **************************************************************************************************
938 SUBROUTINE qs_scf_post_charges(input, logger, qs_env)
939 TYPE(section_vals_type), POINTER :: input
940 TYPE(cp_logger_type), POINTER :: logger
941 TYPE(qs_environment_type), POINTER :: qs_env
942
943 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_charges'
944
945 INTEGER :: handle, print_level, unit_nr
946 LOGICAL :: do_kpoints, print_it
947 TYPE(section_vals_type), POINTER :: density_fit_section, print_key
948
949 CALL timeset(routinen, handle)
950
951 CALL get_qs_env(qs_env=qs_env, do_kpoints=do_kpoints)
952
953 ! Mulliken charges require no further computation and are printed from write_mo_free_results
954
955 ! Compute the Lowdin charges
956 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%LOWDIN")
957 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
958 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%LOWDIN", extension=".lowdin", &
959 log_filename=.false.)
960 print_level = 1
961 CALL section_vals_val_get(print_key, "PRINT_GOP", l_val=print_it)
962 IF (print_it) print_level = 2
963 CALL section_vals_val_get(print_key, "PRINT_ALL", l_val=print_it)
964 IF (print_it) print_level = 3
965 IF (do_kpoints) THEN
966 cpwarn("Lowdin charges not implemented for k-point calculations!")
967 ELSE
968 CALL lowdin_population_analysis(qs_env, unit_nr, print_level)
969 END IF
970 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%LOWDIN")
971 END IF
972
973 ! Compute the RESP charges
974 CALL resp_fit(qs_env)
975
976 ! Compute the Density Derived Atomic Point charges with the Bloechl scheme
977 print_key => section_vals_get_subs_vals(input, "PROPERTIES%FIT_CHARGE")
978 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
979 unit_nr = cp_print_key_unit_nr(logger, input, "PROPERTIES%FIT_CHARGE", extension=".Fitcharge", &
980 log_filename=.false.)
981 density_fit_section => section_vals_get_subs_vals(input, "DFT%DENSITY_FITTING")
982 CALL get_ddapc(qs_env, .false., density_fit_section, iwc=unit_nr)
983 CALL cp_print_key_finished_output(unit_nr, logger, input, "PROPERTIES%FIT_CHARGE")
984 END IF
985
986 CALL timestop(handle)
987
988 END SUBROUTINE qs_scf_post_charges
989
990! **************************************************************************************************
991!> \brief Computes and prints the Cube Files for MO
992!> \param input ...
993!> \param dft_section ...
994!> \param dft_control ...
995!> \param logger ...
996!> \param qs_env the qs_env in which the qs_env lives
997!> \param mo_coeff ...
998!> \param wf_g ...
999!> \param wf_r ...
1000!> \param particles ...
1001!> \param homo ...
1002!> \param ispin ...
1003! **************************************************************************************************
1004 SUBROUTINE qs_scf_post_occ_cubes(input, dft_section, dft_control, logger, qs_env, &
1005 mo_coeff, wf_g, wf_r, particles, homo, ispin)
1006 TYPE(section_vals_type), POINTER :: input, dft_section
1007 TYPE(dft_control_type), POINTER :: dft_control
1008 TYPE(cp_logger_type), POINTER :: logger
1009 TYPE(qs_environment_type), POINTER :: qs_env
1010 TYPE(cp_fm_type), INTENT(IN) :: mo_coeff
1011 TYPE(pw_c1d_gs_type), INTENT(INOUT) :: wf_g
1012 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: wf_r
1013 TYPE(particle_list_type), POINTER :: particles
1014 INTEGER, INTENT(IN) :: homo, ispin
1015
1016 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_occ_cubes'
1017
1018 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube, title
1019 INTEGER :: handle, i, ir, ivector, n_rep, nhomo, &
1020 nlist, unit_nr
1021 INTEGER, DIMENSION(:), POINTER :: list, list_index
1022 LOGICAL :: append_cube, mpi_io
1023 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1024 TYPE(cell_type), POINTER :: cell
1025 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1026 TYPE(pw_env_type), POINTER :: pw_env
1027 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1028
1029 CALL timeset(routinen, handle)
1030
1031 NULLIFY (list_index)
1032
1033 IF (btest(cp_print_key_should_output(logger%iter_info, dft_section, "PRINT%MO_CUBES") &
1034 , cp_p_file) .AND. section_get_lval(dft_section, "PRINT%MO_CUBES%WRITE_CUBE")) THEN
1035 nhomo = section_get_ival(dft_section, "PRINT%MO_CUBES%NHOMO")
1036 append_cube = section_get_lval(dft_section, "PRINT%MO_CUBES%APPEND")
1037 my_pos_cube = "REWIND"
1038 IF (append_cube) THEN
1039 my_pos_cube = "APPEND"
1040 END IF
1041 CALL section_vals_val_get(dft_section, "PRINT%MO_CUBES%HOMO_LIST", n_rep_val=n_rep)
1042 IF (n_rep > 0) THEN ! write the cubes of the list
1043 nlist = 0
1044 DO ir = 1, n_rep
1045 NULLIFY (list)
1046 CALL section_vals_val_get(dft_section, "PRINT%MO_CUBES%HOMO_LIST", i_rep_val=ir, &
1047 i_vals=list)
1048 IF (ASSOCIATED(list)) THEN
1049 CALL reallocate(list_index, 1, nlist + SIZE(list))
1050 DO i = 1, SIZE(list)
1051 list_index(i + nlist) = list(i)
1052 END DO
1053 nlist = nlist + SIZE(list)
1054 END IF
1055 END DO
1056 ELSE
1057
1058 IF (nhomo == -1) nhomo = homo
1059 nlist = homo - max(1, homo - nhomo + 1) + 1
1060 ALLOCATE (list_index(nlist))
1061 DO i = 1, nlist
1062 list_index(i) = max(1, homo - nhomo + 1) + i - 1
1063 END DO
1064 END IF
1065 DO i = 1, nlist
1066 ivector = list_index(i)
1067 CALL get_qs_env(qs_env=qs_env, &
1068 atomic_kind_set=atomic_kind_set, &
1069 qs_kind_set=qs_kind_set, &
1070 cell=cell, &
1071 particle_set=particle_set, &
1072 pw_env=pw_env)
1073 CALL calculate_wavefunction(mo_coeff, ivector, wf_r, wf_g, atomic_kind_set, qs_kind_set, &
1074 cell, dft_control, particle_set, pw_env)
1075 WRITE (filename, '(a4,I5.5,a1,I1.1)') "WFN_", ivector, "_", ispin
1076 mpi_io = .true.
1077 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MO_CUBES", extension=".cube", &
1078 middle_name=trim(filename), file_position=my_pos_cube, log_filename=.false., &
1079 mpi_io=mpi_io)
1080 WRITE (title, *) "WAVEFUNCTION ", ivector, " spin ", ispin, " i.e. HOMO - ", ivector - homo
1081 CALL cp_pw_to_cube(wf_r, unit_nr, title, particles=particles, &
1082 stride=section_get_ivals(dft_section, "PRINT%MO_CUBES%STRIDE"), mpi_io=mpi_io)
1083 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MO_CUBES", mpi_io=mpi_io)
1084 END DO
1085 IF (ASSOCIATED(list_index)) DEALLOCATE (list_index)
1086 END IF
1087
1088 CALL timestop(handle)
1089
1090 END SUBROUTINE qs_scf_post_occ_cubes
1091
1092! **************************************************************************************************
1093!> \brief Computes and prints the Cube Files for MO
1094!> \param input ...
1095!> \param dft_section ...
1096!> \param dft_control ...
1097!> \param logger ...
1098!> \param qs_env the qs_env in which the qs_env lives
1099!> \param unoccupied_orbs ...
1100!> \param wf_g ...
1101!> \param wf_r ...
1102!> \param particles ...
1103!> \param nlumos ...
1104!> \param homo ...
1105!> \param ispin ...
1106!> \param lumo ...
1107! **************************************************************************************************
1108 SUBROUTINE qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_env, &
1109 unoccupied_orbs, wf_g, wf_r, particles, nlumos, homo, ispin, lumo)
1110
1111 TYPE(section_vals_type), POINTER :: input, dft_section
1112 TYPE(dft_control_type), POINTER :: dft_control
1113 TYPE(cp_logger_type), POINTER :: logger
1114 TYPE(qs_environment_type), POINTER :: qs_env
1115 TYPE(cp_fm_type), INTENT(IN) :: unoccupied_orbs
1116 TYPE(pw_c1d_gs_type), INTENT(INOUT) :: wf_g
1117 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: wf_r
1118 TYPE(particle_list_type), POINTER :: particles
1119 INTEGER, INTENT(IN) :: nlumos, homo, ispin
1120 INTEGER, INTENT(IN), OPTIONAL :: lumo
1121
1122 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_unocc_cubes'
1123
1124 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube, title
1125 INTEGER :: handle, ifirst, index_mo, ivector, &
1126 unit_nr
1127 LOGICAL :: append_cube, mpi_io
1128 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1129 TYPE(cell_type), POINTER :: cell
1130 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1131 TYPE(pw_env_type), POINTER :: pw_env
1132 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1133
1134 CALL timeset(routinen, handle)
1135
1136 IF (btest(cp_print_key_should_output(logger%iter_info, dft_section, "PRINT%MO_CUBES"), cp_p_file) &
1137 .AND. section_get_lval(dft_section, "PRINT%MO_CUBES%WRITE_CUBE")) THEN
1138 NULLIFY (qs_kind_set, particle_set, pw_env, cell)
1139 append_cube = section_get_lval(dft_section, "PRINT%MO_CUBES%APPEND")
1140 my_pos_cube = "REWIND"
1141 IF (append_cube) THEN
1142 my_pos_cube = "APPEND"
1143 END IF
1144 ifirst = 1
1145 IF (PRESENT(lumo)) ifirst = lumo
1146 DO ivector = ifirst, ifirst + nlumos - 1
1147 CALL get_qs_env(qs_env=qs_env, &
1148 atomic_kind_set=atomic_kind_set, &
1149 qs_kind_set=qs_kind_set, &
1150 cell=cell, &
1151 particle_set=particle_set, &
1152 pw_env=pw_env)
1153 CALL calculate_wavefunction(unoccupied_orbs, ivector, wf_r, wf_g, atomic_kind_set, &
1154 qs_kind_set, cell, dft_control, particle_set, pw_env)
1155
1156 IF (ifirst == 1) THEN
1157 index_mo = homo + ivector
1158 ELSE
1159 index_mo = ivector
1160 END IF
1161 WRITE (filename, '(a4,I5.5,a1,I1.1)') "WFN_", index_mo, "_", ispin
1162 mpi_io = .true.
1163
1164 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MO_CUBES", extension=".cube", &
1165 middle_name=trim(filename), file_position=my_pos_cube, log_filename=.false., &
1166 mpi_io=mpi_io)
1167 WRITE (title, *) "WAVEFUNCTION ", index_mo, " spin ", ispin, " i.e. LUMO + ", ifirst + ivector - 2
1168 CALL cp_pw_to_cube(wf_r, unit_nr, title, particles=particles, &
1169 stride=section_get_ivals(dft_section, "PRINT%MO_CUBES%STRIDE"), mpi_io=mpi_io)
1170 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MO_CUBES", mpi_io=mpi_io)
1171 END DO
1172 END IF
1173
1174 CALL timestop(handle)
1175
1176 END SUBROUTINE qs_scf_post_unocc_cubes
1177
1178! **************************************************************************************************
1179!> \brief Computes and prints electric moments
1180!> \param input ...
1181!> \param logger ...
1182!> \param qs_env the qs_env in which the qs_env lives
1183!> \param output_unit ...
1184! **************************************************************************************************
1185 SUBROUTINE qs_scf_post_moments(input, logger, qs_env, output_unit)
1186 TYPE(section_vals_type), POINTER :: input
1187 TYPE(cp_logger_type), POINTER :: logger
1188 TYPE(qs_environment_type), POINTER :: qs_env
1189 INTEGER, INTENT(IN) :: output_unit
1190
1191 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_moments'
1192
1193 CHARACTER(LEN=default_path_length) :: filename
1194 INTEGER :: handle, maxmom, reference, unit_nr
1195 LOGICAL :: com_nl, do_kpoints, magnetic, periodic, &
1196 second_ref_point, vel_reprs
1197 REAL(kind=dp), DIMENSION(:), POINTER :: ref_point
1198 TYPE(section_vals_type), POINTER :: print_key
1199
1200 CALL timeset(routinen, handle)
1201
1202 print_key => section_vals_get_subs_vals(section_vals=input, &
1203 subsection_name="DFT%PRINT%MOMENTS")
1204
1205 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
1206
1207 maxmom = section_get_ival(section_vals=input, &
1208 keyword_name="DFT%PRINT%MOMENTS%MAX_MOMENT")
1209 periodic = section_get_lval(section_vals=input, &
1210 keyword_name="DFT%PRINT%MOMENTS%PERIODIC")
1211 reference = section_get_ival(section_vals=input, &
1212 keyword_name="DFT%PRINT%MOMENTS%REFERENCE")
1213 magnetic = section_get_lval(section_vals=input, &
1214 keyword_name="DFT%PRINT%MOMENTS%MAGNETIC")
1215 vel_reprs = section_get_lval(section_vals=input, &
1216 keyword_name="DFT%PRINT%MOMENTS%VEL_REPRS")
1217 com_nl = section_get_lval(section_vals=input, &
1218 keyword_name="DFT%PRINT%MOMENTS%COM_NL")
1219 second_ref_point = section_get_lval(section_vals=input, &
1220 keyword_name="DFT%PRINT%MOMENTS%SECOND_REFERENCE_POINT")
1221
1222 NULLIFY (ref_point)
1223 CALL section_vals_val_get(input, "DFT%PRINT%MOMENTS%REF_POINT", r_vals=ref_point)
1224 unit_nr = cp_print_key_unit_nr(logger=logger, basis_section=input, &
1225 print_key_path="DFT%PRINT%MOMENTS", extension=".dat", &
1226 middle_name="moments", log_filename=.false.)
1227
1228 IF (output_unit > 0) THEN
1229 IF (unit_nr /= output_unit) THEN
1230 INQUIRE (unit=unit_nr, name=filename)
1231 WRITE (unit=output_unit, fmt="(/,T2,A,2(/,T3,A),/)") &
1232 "MOMENTS", "The electric/magnetic moments are written to file:", &
1233 trim(filename)
1234 ELSE
1235 WRITE (unit=output_unit, fmt="(/,T2,A)") "ELECTRIC/MAGNETIC MOMENTS"
1236 END IF
1237 END IF
1238
1239 CALL get_qs_env(qs_env, do_kpoints=do_kpoints)
1240
1241 IF (do_kpoints) THEN
1242 cpwarn("Moments not implemented for k-point calculations!")
1243 ELSE
1244 IF (periodic) THEN
1245 CALL qs_moment_berry_phase(qs_env, magnetic, maxmom, reference, ref_point, unit_nr)
1246 ELSE
1247 CALL qs_moment_locop(qs_env, magnetic, maxmom, reference, ref_point, unit_nr, vel_reprs, com_nl)
1248 END IF
1249 END IF
1250
1251 CALL cp_print_key_finished_output(unit_nr=unit_nr, logger=logger, &
1252 basis_section=input, print_key_path="DFT%PRINT%MOMENTS")
1253
1254 IF (second_ref_point) THEN
1255 reference = section_get_ival(section_vals=input, &
1256 keyword_name="DFT%PRINT%MOMENTS%REFERENCE_2")
1257
1258 NULLIFY (ref_point)
1259 CALL section_vals_val_get(input, "DFT%PRINT%MOMENTS%REF_POINT_2", r_vals=ref_point)
1260 unit_nr = cp_print_key_unit_nr(logger=logger, basis_section=input, &
1261 print_key_path="DFT%PRINT%MOMENTS", extension=".dat", &
1262 middle_name="moments_refpoint_2", log_filename=.false.)
1263
1264 IF (output_unit > 0) THEN
1265 IF (unit_nr /= output_unit) THEN
1266 INQUIRE (unit=unit_nr, name=filename)
1267 WRITE (unit=output_unit, fmt="(/,T2,A,2(/,T3,A),/)") &
1268 "MOMENTS", "The electric/magnetic moments for the second reference point are written to file:", &
1269 trim(filename)
1270 ELSE
1271 WRITE (unit=output_unit, fmt="(/,T2,A)") "ELECTRIC/MAGNETIC MOMENTS"
1272 END IF
1273 END IF
1274 IF (do_kpoints) THEN
1275 cpwarn("Moments not implemented for k-point calculations!")
1276 ELSE
1277 IF (periodic) THEN
1278 CALL qs_moment_berry_phase(qs_env, magnetic, maxmom, reference, ref_point, unit_nr)
1279 ELSE
1280 CALL qs_moment_locop(qs_env, magnetic, maxmom, reference, ref_point, unit_nr, vel_reprs, com_nl)
1281 END IF
1282 END IF
1283 CALL cp_print_key_finished_output(unit_nr=unit_nr, logger=logger, &
1284 basis_section=input, print_key_path="DFT%PRINT%MOMENTS")
1285 END IF
1286
1287 END IF
1288
1289 CALL timestop(handle)
1290
1291 END SUBROUTINE qs_scf_post_moments
1292
1293! **************************************************************************************************
1294!> \brief Computes and prints the X-ray diffraction spectrum.
1295!> \param input ...
1296!> \param dft_section ...
1297!> \param logger ...
1298!> \param qs_env the qs_env in which the qs_env lives
1299!> \param output_unit ...
1300! **************************************************************************************************
1301 SUBROUTINE qs_scf_post_xray(input, dft_section, logger, qs_env, output_unit)
1302
1303 TYPE(section_vals_type), POINTER :: input, dft_section
1304 TYPE(cp_logger_type), POINTER :: logger
1305 TYPE(qs_environment_type), POINTER :: qs_env
1306 INTEGER, INTENT(IN) :: output_unit
1307
1308 CHARACTER(LEN=*), PARAMETER :: routinen = 'qs_scf_post_xray'
1309
1310 CHARACTER(LEN=default_path_length) :: filename
1311 INTEGER :: handle, unit_nr
1312 REAL(kind=dp) :: q_max
1313 TYPE(section_vals_type), POINTER :: print_key
1314
1315 CALL timeset(routinen, handle)
1316
1317 print_key => section_vals_get_subs_vals(section_vals=input, &
1318 subsection_name="DFT%PRINT%XRAY_DIFFRACTION_SPECTRUM")
1319
1320 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
1321 q_max = section_get_rval(section_vals=dft_section, &
1322 keyword_name="PRINT%XRAY_DIFFRACTION_SPECTRUM%Q_MAX")
1323 unit_nr = cp_print_key_unit_nr(logger=logger, &
1324 basis_section=input, &
1325 print_key_path="DFT%PRINT%XRAY_DIFFRACTION_SPECTRUM", &
1326 extension=".dat", &
1327 middle_name="xrd", &
1328 log_filename=.false.)
1329 IF (output_unit > 0) THEN
1330 INQUIRE (unit=unit_nr, name=filename)
1331 WRITE (unit=output_unit, fmt="(/,/,T2,A)") &
1332 "X-RAY DIFFRACTION SPECTRUM"
1333 IF (unit_nr /= output_unit) THEN
1334 WRITE (unit=output_unit, fmt="(/,T3,A,/,/,T3,A,/)") &
1335 "The coherent X-ray diffraction spectrum is written to the file:", &
1336 trim(filename)
1337 END IF
1338 END IF
1339 CALL xray_diffraction_spectrum(qs_env=qs_env, &
1340 unit_number=unit_nr, &
1341 q_max=q_max)
1342 CALL cp_print_key_finished_output(unit_nr=unit_nr, &
1343 logger=logger, &
1344 basis_section=input, &
1345 print_key_path="DFT%PRINT%XRAY_DIFFRACTION_SPECTRUM")
1346 END IF
1347
1348 CALL timestop(handle)
1349
1350 END SUBROUTINE qs_scf_post_xray
1351
1352! **************************************************************************************************
1353!> \brief Computes and prints Electric Field Gradient
1354!> \param input ...
1355!> \param logger ...
1356!> \param qs_env the qs_env in which the qs_env lives
1357! **************************************************************************************************
1358 SUBROUTINE qs_scf_post_efg(input, logger, qs_env)
1359 TYPE(section_vals_type), POINTER :: input
1360 TYPE(cp_logger_type), POINTER :: logger
1361 TYPE(qs_environment_type), POINTER :: qs_env
1362
1363 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_efg'
1364
1365 INTEGER :: handle
1366 TYPE(section_vals_type), POINTER :: print_key
1367
1368 CALL timeset(routinen, handle)
1369
1370 print_key => section_vals_get_subs_vals(section_vals=input, &
1371 subsection_name="DFT%PRINT%ELECTRIC_FIELD_GRADIENT")
1372 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), &
1373 cp_p_file)) THEN
1374 CALL qs_efg_calc(qs_env=qs_env)
1375 END IF
1376
1377 CALL timestop(handle)
1378
1379 END SUBROUTINE qs_scf_post_efg
1380
1381! **************************************************************************************************
1382!> \brief Computes the Electron Transfer Coupling matrix element
1383!> \param input ...
1384!> \param qs_env the qs_env in which the qs_env lives
1385!> \param dft_control ...
1386! **************************************************************************************************
1387 SUBROUTINE qs_scf_post_et(input, qs_env, dft_control)
1388 TYPE(section_vals_type), POINTER :: input
1389 TYPE(qs_environment_type), POINTER :: qs_env
1390 TYPE(dft_control_type), POINTER :: dft_control
1391
1392 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_et'
1393
1394 INTEGER :: handle, ispin
1395 LOGICAL :: do_et
1396 TYPE(cp_fm_type), DIMENSION(:), POINTER :: my_mos
1397 TYPE(section_vals_type), POINTER :: et_section
1398
1399 CALL timeset(routinen, handle)
1400
1401 do_et = .false.
1402 et_section => section_vals_get_subs_vals(input, "PROPERTIES%ET_COUPLING")
1403 CALL section_vals_get(et_section, explicit=do_et)
1404 IF (do_et) THEN
1405 IF (qs_env%et_coupling%first_run) THEN
1406 NULLIFY (my_mos)
1407 ALLOCATE (my_mos(dft_control%nspins))
1408 ALLOCATE (qs_env%et_coupling%et_mo_coeff(dft_control%nspins))
1409 DO ispin = 1, dft_control%nspins
1410 CALL cp_fm_create(matrix=my_mos(ispin), &
1411 matrix_struct=qs_env%mos(ispin)%mo_coeff%matrix_struct, &
1412 name="FIRST_RUN_COEFF"//trim(adjustl(cp_to_string(ispin)))//"MATRIX")
1413 CALL cp_fm_to_fm(qs_env%mos(ispin)%mo_coeff, &
1414 my_mos(ispin))
1415 END DO
1416 CALL set_et_coupling_type(qs_env%et_coupling, et_mo_coeff=my_mos)
1417 DEALLOCATE (my_mos)
1418 END IF
1419 END IF
1420
1421 CALL timestop(handle)
1422
1423 END SUBROUTINE qs_scf_post_et
1424
1425! **************************************************************************************************
1426!> \brief compute the electron localization function
1427!>
1428!> \param input ...
1429!> \param logger ...
1430!> \param qs_env ...
1431!> \par History
1432!> 2012-07 Created [MI]
1433! **************************************************************************************************
1434 SUBROUTINE qs_scf_post_elf(input, logger, qs_env)
1435 TYPE(section_vals_type), POINTER :: input
1436 TYPE(cp_logger_type), POINTER :: logger
1437 TYPE(qs_environment_type), POINTER :: qs_env
1438
1439 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_elf'
1440
1441 CHARACTER(LEN=default_path_length) :: filename, mpi_filename, my_pos_cube, &
1442 title
1443 INTEGER :: handle, ispin, output_unit, unit_nr
1444 LOGICAL :: append_cube, gapw, mpi_io
1445 REAL(dp) :: rho_cutoff
1446 TYPE(dft_control_type), POINTER :: dft_control
1447 TYPE(particle_list_type), POINTER :: particles
1448 TYPE(pw_env_type), POINTER :: pw_env
1449 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
1450 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1451 TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: elf_r
1452 TYPE(qs_subsys_type), POINTER :: subsys
1453 TYPE(section_vals_type), POINTER :: elf_section
1454
1455 CALL timeset(routinen, handle)
1456 output_unit = cp_logger_get_default_io_unit(logger)
1457
1458 elf_section => section_vals_get_subs_vals(input, "DFT%PRINT%ELF_CUBE")
1459 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
1460 "DFT%PRINT%ELF_CUBE"), cp_p_file)) THEN
1461
1462 NULLIFY (dft_control, pw_env, auxbas_pw_pool, pw_pools, particles, subsys)
1463 CALL get_qs_env(qs_env, dft_control=dft_control, pw_env=pw_env, subsys=subsys)
1464 CALL qs_subsys_get(subsys, particles=particles)
1465
1466 gapw = dft_control%qs_control%gapw
1467 IF (.NOT. gapw) THEN
1468 ! allocate
1469 ALLOCATE (elf_r(dft_control%nspins))
1470 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
1471 pw_pools=pw_pools)
1472 DO ispin = 1, dft_control%nspins
1473 CALL auxbas_pw_pool%create_pw(elf_r(ispin))
1474 CALL pw_zero(elf_r(ispin))
1475 END DO
1476
1477 IF (output_unit > 0) THEN
1478 WRITE (unit=output_unit, fmt="(/,T15,A,/)") &
1479 " ----- ELF is computed on the real space grid -----"
1480 END IF
1481 rho_cutoff = section_get_rval(elf_section, "density_cutoff")
1482 CALL qs_elf_calc(qs_env, elf_r, rho_cutoff)
1483
1484 ! write ELF into cube file
1485 append_cube = section_get_lval(elf_section, "APPEND")
1486 my_pos_cube = "REWIND"
1487 IF (append_cube) THEN
1488 my_pos_cube = "APPEND"
1489 END IF
1490
1491 DO ispin = 1, dft_control%nspins
1492 WRITE (filename, '(a5,I1.1)') "ELF_S", ispin
1493 WRITE (title, *) "ELF spin ", ispin
1494 mpi_io = .true.
1495 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%ELF_CUBE", extension=".cube", &
1496 middle_name=trim(filename), file_position=my_pos_cube, log_filename=.false., &
1497 mpi_io=mpi_io, fout=mpi_filename)
1498 IF (output_unit > 0) THEN
1499 IF (.NOT. mpi_io) THEN
1500 INQUIRE (unit=unit_nr, name=filename)
1501 ELSE
1502 filename = mpi_filename
1503 END IF
1504 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
1505 "ELF is written in cube file format to the file:", &
1506 trim(filename)
1507 END IF
1508
1509 CALL cp_pw_to_cube(elf_r(ispin), unit_nr, title, particles=particles, &
1510 stride=section_get_ivals(elf_section, "STRIDE"), mpi_io=mpi_io)
1511 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%ELF_CUBE", mpi_io=mpi_io)
1512
1513 CALL auxbas_pw_pool%give_back_pw(elf_r(ispin))
1514 END DO
1515
1516 ! deallocate
1517 DEALLOCATE (elf_r)
1518
1519 ELSE
1520 ! not implemented
1521 cpwarn("ELF not implemented for GAPW calculations!")
1522 END IF
1523
1524 END IF ! print key
1525
1526 CALL timestop(handle)
1527
1528 END SUBROUTINE qs_scf_post_elf
1529
1530! **************************************************************************************************
1531!> \brief computes the condition number of the overlap matrix and
1532!> prints the value of the total energy. This is needed
1533!> for BASIS_MOLOPT optimizations
1534!> \param input ...
1535!> \param logger ...
1536!> \param qs_env the qs_env in which the qs_env lives
1537!> \par History
1538!> 2007-07 Created [Joost VandeVondele]
1539! **************************************************************************************************
1540 SUBROUTINE qs_scf_post_molopt(input, logger, qs_env)
1541 TYPE(section_vals_type), POINTER :: input
1542 TYPE(cp_logger_type), POINTER :: logger
1543 TYPE(qs_environment_type), POINTER :: qs_env
1544
1545 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_molopt'
1546
1547 INTEGER :: handle, nao, unit_nr
1548 REAL(kind=dp) :: s_cond_number
1549 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues
1550 TYPE(cp_fm_struct_type), POINTER :: ao_ao_fmstruct
1551 TYPE(cp_fm_type) :: fm_s, fm_work
1552 TYPE(cp_fm_type), POINTER :: mo_coeff
1553 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
1554 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
1555 TYPE(qs_energy_type), POINTER :: energy
1556 TYPE(section_vals_type), POINTER :: print_key
1557
1558 CALL timeset(routinen, handle)
1559
1560 print_key => section_vals_get_subs_vals(section_vals=input, &
1561 subsection_name="DFT%PRINT%BASIS_MOLOPT_QUANTITIES")
1562 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), &
1563 cp_p_file)) THEN
1564
1565 CALL get_qs_env(qs_env, energy=energy, matrix_s=matrix_s, mos=mos)
1566
1567 ! set up the two needed full matrices, using mo_coeff as a template
1568 CALL get_mo_set(mo_set=mos(1), mo_coeff=mo_coeff, nao=nao)
1569 CALL cp_fm_struct_create(fmstruct=ao_ao_fmstruct, &
1570 nrow_global=nao, ncol_global=nao, &
1571 template_fmstruct=mo_coeff%matrix_struct)
1572 CALL cp_fm_create(fm_s, matrix_struct=ao_ao_fmstruct, &
1573 name="fm_s")
1574 CALL cp_fm_create(fm_work, matrix_struct=ao_ao_fmstruct, &
1575 name="fm_work")
1576 CALL cp_fm_struct_release(ao_ao_fmstruct)
1577 ALLOCATE (eigenvalues(nao))
1578
1579 CALL copy_dbcsr_to_fm(matrix_s(1)%matrix, fm_s)
1580 CALL choose_eigv_solver(fm_s, fm_work, eigenvalues)
1581
1582 CALL cp_fm_release(fm_s)
1583 CALL cp_fm_release(fm_work)
1584
1585 s_cond_number = maxval(abs(eigenvalues))/max(minval(abs(eigenvalues)), epsilon(0.0_dp))
1586
1587 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%BASIS_MOLOPT_QUANTITIES", &
1588 extension=".molopt")
1589
1590 IF (unit_nr > 0) THEN
1591 ! please keep this format fixed, needs to be grepable for molopt
1592 ! optimizations
1593 WRITE (unit_nr, '(T2,A28,2A25)') "", "Tot. Ener.", "S Cond. Numb."
1594 WRITE (unit_nr, '(T2,A28,2E25.17)') "BASIS_MOLOPT_QUANTITIES", energy%total, s_cond_number
1595 END IF
1596
1597 CALL cp_print_key_finished_output(unit_nr, logger, input, &
1598 "DFT%PRINT%BASIS_MOLOPT_QUANTITIES")
1599
1600 END IF
1601
1602 CALL timestop(handle)
1603
1604 END SUBROUTINE qs_scf_post_molopt
1605
1606! **************************************************************************************************
1607!> \brief Dumps EPR
1608!> \param input ...
1609!> \param logger ...
1610!> \param qs_env the qs_env in which the qs_env lives
1611! **************************************************************************************************
1612 SUBROUTINE qs_scf_post_epr(input, logger, qs_env)
1613 TYPE(section_vals_type), POINTER :: input
1614 TYPE(cp_logger_type), POINTER :: logger
1615 TYPE(qs_environment_type), POINTER :: qs_env
1616
1617 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_epr'
1618
1619 INTEGER :: handle
1620 TYPE(section_vals_type), POINTER :: print_key
1621
1622 CALL timeset(routinen, handle)
1623
1624 print_key => section_vals_get_subs_vals(section_vals=input, &
1625 subsection_name="DFT%PRINT%HYPERFINE_COUPLING_TENSOR")
1626 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), &
1627 cp_p_file)) THEN
1628 CALL qs_epr_hyp_calc(qs_env=qs_env)
1629 END IF
1630
1631 CALL timestop(handle)
1632
1633 END SUBROUTINE qs_scf_post_epr
1634
1635! **************************************************************************************************
1636!> \brief Interface routine to trigger writing of results available from normal
1637!> SCF. Can write MO-dependent and MO free results (needed for call from
1638!> the linear scaling code)
1639!> \param qs_env the qs_env in which the qs_env lives
1640!> \param scf_env ...
1641! **************************************************************************************************
1642 SUBROUTINE write_available_results(qs_env, scf_env)
1643 TYPE(qs_environment_type), POINTER :: qs_env
1644 TYPE(qs_scf_env_type), OPTIONAL, POINTER :: scf_env
1645
1646 CHARACTER(len=*), PARAMETER :: routinen = 'write_available_results'
1647
1648 INTEGER :: handle
1649
1650 CALL timeset(routinen, handle)
1651
1652 ! those properties that require MOs (not suitable density matrix based methods)
1653 CALL write_mo_dependent_results(qs_env, scf_env)
1654
1655 ! those that depend only on the density matrix, they should be linear scaling in their implementation
1656 CALL write_mo_free_results(qs_env)
1657
1658 CALL timestop(handle)
1659
1660 END SUBROUTINE write_available_results
1661
1662! **************************************************************************************************
1663!> \brief Write QS results available if MO's are present (if switched on through the print_keys)
1664!> Writes only MO dependent results. Split is necessary as ls_scf does not
1665!> provide MO's
1666!> \param qs_env the qs_env in which the qs_env lives
1667!> \param scf_env ...
1668! **************************************************************************************************
1669 SUBROUTINE write_mo_dependent_results(qs_env, scf_env)
1670 TYPE(qs_environment_type), POINTER :: qs_env
1671 TYPE(qs_scf_env_type), OPTIONAL, POINTER :: scf_env
1672
1673 CHARACTER(len=*), PARAMETER :: routinen = 'write_mo_dependent_results'
1674
1675 INTEGER :: handle, homo, ispin, nmo, output_unit
1676 LOGICAL :: all_equal, do_kpoints, explicit
1677 REAL(kind=dp) :: maxocc, s_square, s_square_ideal, &
1678 total_abs_spin_dens, total_spin_dens
1679 REAL(kind=dp), DIMENSION(:), POINTER :: mo_eigenvalues, occupation_numbers
1680 TYPE(admm_type), POINTER :: admm_env
1681 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1682 TYPE(cell_type), POINTER :: cell
1683 TYPE(cp_fm_type), POINTER :: mo_coeff
1684 TYPE(cp_logger_type), POINTER :: logger
1685 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_rmpv, matrix_s
1686 TYPE(dbcsr_type), POINTER :: mo_coeff_deriv
1687 TYPE(dft_control_type), POINTER :: dft_control
1688 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
1689 TYPE(molecule_type), POINTER :: molecule_set(:)
1690 TYPE(particle_list_type), POINTER :: particles
1691 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1692 TYPE(pw_env_type), POINTER :: pw_env
1693 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
1694 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1695 TYPE(pw_r3d_rs_type) :: wf_r
1696 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
1697 TYPE(qs_energy_type), POINTER :: energy
1698 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1699 TYPE(qs_rho_type), POINTER :: rho
1700 TYPE(qs_subsys_type), POINTER :: subsys
1701 TYPE(scf_control_type), POINTER :: scf_control
1702 TYPE(section_vals_type), POINTER :: dft_section, input, sprint_section, &
1703 trexio_section
1704
1705! TYPE(kpoint_type), POINTER :: kpoints
1706
1707 CALL timeset(routinen, handle)
1708
1709 NULLIFY (cell, dft_control, pw_env, auxbas_pw_pool, pw_pools, mo_coeff, &
1710 mo_coeff_deriv, mo_eigenvalues, mos, atomic_kind_set, qs_kind_set, &
1711 particle_set, rho, ks_rmpv, matrix_s, scf_control, dft_section, &
1712 molecule_set, input, particles, subsys, rho_r)
1713
1714 logger => cp_get_default_logger()
1715 output_unit = cp_logger_get_default_io_unit(logger)
1716
1717 cpassert(ASSOCIATED(qs_env))
1718 CALL get_qs_env(qs_env, &
1719 dft_control=dft_control, &
1720 molecule_set=molecule_set, &
1721 atomic_kind_set=atomic_kind_set, &
1722 particle_set=particle_set, &
1723 qs_kind_set=qs_kind_set, &
1724 admm_env=admm_env, &
1725 scf_control=scf_control, &
1726 input=input, &
1727 cell=cell, &
1728 subsys=subsys)
1729 CALL qs_subsys_get(subsys, particles=particles)
1730 CALL get_qs_env(qs_env, rho=rho)
1731 CALL qs_rho_get(rho, rho_r=rho_r)
1732
1733 ! k points
1734 CALL get_qs_env(qs_env, do_kpoints=do_kpoints)
1735
1736 ! Write last MO information to output file if requested
1737 dft_section => section_vals_get_subs_vals(input, "DFT")
1738 IF (.NOT. qs_env%run_rtp) THEN
1739 CALL qs_scf_write_mos(qs_env, scf_env, final_mos=.true.)
1740 trexio_section => section_vals_get_subs_vals(dft_section, "PRINT%TREXIO")
1741 CALL section_vals_get(trexio_section, explicit=explicit)
1742 IF (explicit) THEN
1743 CALL write_trexio(qs_env, trexio_section)
1744 END IF
1745 IF (.NOT. do_kpoints) THEN
1746 CALL get_qs_env(qs_env, mos=mos, matrix_ks=ks_rmpv)
1747 CALL write_dm_binary_restart(mos, dft_section, ks_rmpv)
1748 sprint_section => section_vals_get_subs_vals(dft_section, "PRINT%MO_MOLDEN")
1749 CALL write_mos_molden(mos, qs_kind_set, particle_set, sprint_section)
1750 ! Write Chargemol .wfx
1751 IF (btest(cp_print_key_should_output(logger%iter_info, &
1752 dft_section, "PRINT%CHARGEMOL"), &
1753 cp_p_file)) THEN
1754 CALL write_wfx(qs_env, dft_section)
1755 END IF
1756 END IF
1757
1758 ! DOS printout after the SCF cycle is completed
1759 IF (btest(cp_print_key_should_output(logger%iter_info, dft_section, "PRINT%DOS") &
1760 , cp_p_file)) THEN
1761 IF (do_kpoints) THEN
1762 CALL calculate_dos_kp(qs_env, dft_section)
1763 ELSE
1764 CALL get_qs_env(qs_env, mos=mos)
1765 CALL calculate_dos(mos, dft_section)
1766 END IF
1767 END IF
1768
1769 ! Print the projected density of states (pDOS) for each atomic kind
1770 IF (btest(cp_print_key_should_output(logger%iter_info, dft_section, "PRINT%PDOS"), &
1771 cp_p_file)) THEN
1772 IF (do_kpoints) THEN
1773 cpwarn("Projected density of states (pDOS) is not implemented for k points")
1774 ELSE
1775 CALL get_qs_env(qs_env, &
1776 mos=mos, &
1777 matrix_ks=ks_rmpv)
1778 DO ispin = 1, dft_control%nspins
1779 ! With ADMM, we have to modify the Kohn-Sham matrix
1780 IF (dft_control%do_admm) THEN
1781 CALL admm_correct_for_eigenvalues(ispin, admm_env, ks_rmpv(ispin)%matrix)
1782 END IF
1783 IF (PRESENT(scf_env)) THEN
1784 IF (scf_env%method == ot_method_nr) THEN
1785 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, &
1786 eigenvalues=mo_eigenvalues)
1787 IF (ASSOCIATED(qs_env%mo_derivs)) THEN
1788 mo_coeff_deriv => qs_env%mo_derivs(ispin)%matrix
1789 ELSE
1790 mo_coeff_deriv => null()
1791 END IF
1792 CALL calculate_subspace_eigenvalues(mo_coeff, ks_rmpv(ispin)%matrix, mo_eigenvalues, &
1793 do_rotation=.true., &
1794 co_rotate_dbcsr=mo_coeff_deriv)
1795 CALL set_mo_occupation(mo_set=mos(ispin))
1796 END IF
1797 END IF
1798 IF (dft_control%nspins == 2) THEN
1799 CALL calculate_projected_dos(mos(ispin), atomic_kind_set, &
1800 qs_kind_set, particle_set, qs_env, dft_section, ispin=ispin)
1801 ELSE
1802 CALL calculate_projected_dos(mos(ispin), atomic_kind_set, &
1803 qs_kind_set, particle_set, qs_env, dft_section)
1804 END IF
1805 ! With ADMM, we have to undo the modification of the Kohn-Sham matrix
1806 IF (dft_control%do_admm) THEN
1807 CALL admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_rmpv(ispin)%matrix)
1808 END IF
1809 END DO
1810 END IF
1811 END IF
1812 END IF
1813
1814 ! Integrated absolute spin density and spin contamination ***
1815 IF (dft_control%nspins == 2) THEN
1816 CALL get_qs_env(qs_env, mos=mos)
1817 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
1818 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
1819 pw_pools=pw_pools)
1820 CALL auxbas_pw_pool%create_pw(wf_r)
1821 CALL pw_copy(rho_r(1), wf_r)
1822 CALL pw_axpy(rho_r(2), wf_r, alpha=-1._dp)
1823 total_spin_dens = pw_integrate_function(wf_r)
1824 IF (output_unit > 0) WRITE (unit=output_unit, fmt='(/,(T3,A,T61,F20.10))') &
1825 "Integrated spin density: ", total_spin_dens
1826 total_abs_spin_dens = pw_integrate_function(wf_r, oprt="ABS")
1827 IF (output_unit > 0) WRITE (unit=output_unit, fmt='((T3,A,T61,F20.10))') &
1828 "Integrated absolute spin density: ", total_abs_spin_dens
1829 CALL auxbas_pw_pool%give_back_pw(wf_r)
1830 !
1831 ! XXX Fix Me XXX
1832 ! should be extended to the case where added MOs are present
1833 ! should be extended to the k-point case
1834 !
1835 IF (do_kpoints) THEN
1836 cpwarn("Spin contamination estimate not implemented for k-points.")
1837 ELSE
1838 all_equal = .true.
1839 DO ispin = 1, dft_control%nspins
1840 CALL get_mo_set(mo_set=mos(ispin), &
1841 occupation_numbers=occupation_numbers, &
1842 homo=homo, &
1843 nmo=nmo, &
1844 maxocc=maxocc)
1845 IF (nmo > 0) THEN
1846 all_equal = all_equal .AND. &
1847 (all(occupation_numbers(1:homo) == maxocc) .AND. &
1848 all(occupation_numbers(homo + 1:nmo) == 0.0_dp))
1849 END IF
1850 END DO
1851 IF (.NOT. all_equal) THEN
1852 IF (output_unit > 0) WRITE (unit=output_unit, fmt="(T3,A)") &
1853 "WARNING: S**2 computation does not yet treat fractional occupied orbitals"
1854 ELSE
1855 CALL get_qs_env(qs_env=qs_env, &
1856 matrix_s=matrix_s, &
1857 energy=energy)
1858 CALL compute_s_square(mos=mos, matrix_s=matrix_s, s_square=s_square, &
1859 s_square_ideal=s_square_ideal)
1860 IF (output_unit > 0) WRITE (unit=output_unit, fmt='(T3,A,T51,2F15.6)') &
1861 "Ideal and single determinant S**2 : ", s_square_ideal, s_square
1862 energy%s_square = s_square
1863 END IF
1864 END IF
1865 END IF
1866
1867 CALL timestop(handle)
1868
1869 END SUBROUTINE write_mo_dependent_results
1870
1871! **************************************************************************************************
1872!> \brief Write QS results always available (if switched on through the print_keys)
1873!> Can be called from ls_scf
1874!> \param qs_env the qs_env in which the qs_env lives
1875! **************************************************************************************************
1876 SUBROUTINE write_mo_free_results(qs_env)
1877 TYPE(qs_environment_type), POINTER :: qs_env
1878
1879 CHARACTER(len=*), PARAMETER :: routinen = 'write_mo_free_results'
1880 CHARACTER(len=1), DIMENSION(3), PARAMETER :: cdir = (/"x", "y", "z"/)
1881
1882 CHARACTER(LEN=2) :: element_symbol
1883 CHARACTER(LEN=default_path_length) :: filename, mpi_filename, my_pos_cube, &
1884 my_pos_voro
1885 CHARACTER(LEN=default_string_length) :: name, print_density
1886 INTEGER :: after, handle, i, iat, id, ikind, img, iso, ispin, iw, l, n_rep_hf, natom, nd(3), &
1887 ngto, niso, nkind, np, nr, output_unit, print_level, should_print_bqb, should_print_voro, &
1888 unit_nr, unit_nr_voro
1889 LOGICAL :: append_cube, append_voro, do_hfx, do_kpoints, mpi_io, omit_headers, print_it, &
1890 rho_r_valid, voro_print_txt, write_ks, write_xc, xrd_interface
1891 REAL(kind=dp) :: norm_factor, q_max, rho_hard, rho_soft, &
1892 rho_total, rho_total_rspace, udvol, &
1893 volume
1894 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: bfun
1895 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: aedens, ccdens, ppdens
1896 REAL(kind=dp), DIMENSION(3) :: dr
1897 REAL(kind=dp), DIMENSION(:), POINTER :: my_q0
1898 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1899 TYPE(atomic_kind_type), POINTER :: atomic_kind
1900 TYPE(cell_type), POINTER :: cell
1901 TYPE(cp_logger_type), POINTER :: logger
1902 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_hr
1903 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_rmpv, matrix_vxc, rho_ao
1904 TYPE(dft_control_type), POINTER :: dft_control
1905 TYPE(grid_atom_type), POINTER :: grid_atom
1906 TYPE(iao_env_type) :: iao_env
1907 TYPE(mp_para_env_type), POINTER :: para_env
1908 TYPE(particle_list_type), POINTER :: particles
1909 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1910 TYPE(pw_c1d_gs_type) :: aux_g, rho_elec_gspace
1911 TYPE(pw_c1d_gs_type), POINTER :: rho0_s_gs, rho_core, rhoz_cneo_s_gs
1912 TYPE(pw_env_type), POINTER :: pw_env
1913 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
1914 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
1915 TYPE(pw_r3d_rs_type) :: aux_r, rho_elec_rspace, wf_r
1916 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
1917 TYPE(pw_r3d_rs_type), POINTER :: mb_rho, v_hartree_rspace, vee
1918 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1919 TYPE(qs_kind_type), POINTER :: qs_kind
1920 TYPE(qs_rho_type), POINTER :: rho
1921 TYPE(qs_subsys_type), POINTER :: subsys
1922 TYPE(rho0_mpole_type), POINTER :: rho0_mpole
1923 TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set
1924 TYPE(rho_atom_type), POINTER :: rho_atom
1925 TYPE(section_vals_type), POINTER :: dft_section, hfx_section, input, &
1926 print_key, print_key_bqb, &
1927 print_key_voro, xc_section
1928
1929 CALL timeset(routinen, handle)
1930 NULLIFY (cell, dft_control, pw_env, auxbas_pw_pool, pw_pools, hfx_section, &
1931 atomic_kind_set, qs_kind_set, particle_set, rho, ks_rmpv, rho_ao, rho_r, &
1932 dft_section, xc_section, input, particles, subsys, matrix_vxc, v_hartree_rspace, &
1933 vee)
1934
1935 logger => cp_get_default_logger()
1936 output_unit = cp_logger_get_default_io_unit(logger)
1937
1938 cpassert(ASSOCIATED(qs_env))
1939 CALL get_qs_env(qs_env, &
1940 atomic_kind_set=atomic_kind_set, &
1941 qs_kind_set=qs_kind_set, &
1942 particle_set=particle_set, &
1943 cell=cell, &
1944 para_env=para_env, &
1945 dft_control=dft_control, &
1946 input=input, &
1947 do_kpoints=do_kpoints, &
1948 subsys=subsys)
1949 dft_section => section_vals_get_subs_vals(input, "DFT")
1950 CALL qs_subsys_get(subsys, particles=particles)
1951
1952 CALL get_qs_env(qs_env, rho=rho)
1953 CALL qs_rho_get(rho, rho_r=rho_r)
1954
1955 ! Print the total density (electronic + core charge)
1956 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
1957 "DFT%PRINT%TOT_DENSITY_CUBE"), cp_p_file)) THEN
1958 NULLIFY (rho_core, rho0_s_gs, rhoz_cneo_s_gs)
1959 append_cube = section_get_lval(input, "DFT%PRINT%TOT_DENSITY_CUBE%APPEND")
1960 my_pos_cube = "REWIND"
1961 IF (append_cube) THEN
1962 my_pos_cube = "APPEND"
1963 END IF
1964
1965 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, rho_core=rho_core, &
1966 rho0_s_gs=rho0_s_gs, rhoz_cneo_s_gs=rhoz_cneo_s_gs)
1967 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
1968 pw_pools=pw_pools)
1969 CALL auxbas_pw_pool%create_pw(wf_r)
1970 IF (dft_control%qs_control%gapw) THEN
1971 IF (dft_control%qs_control%gapw_control%nopaw_as_gpw) THEN
1972 CALL pw_axpy(rho_core, rho0_s_gs)
1973 IF (ASSOCIATED(rhoz_cneo_s_gs)) THEN
1974 CALL pw_axpy(rhoz_cneo_s_gs, rho0_s_gs)
1975 END IF
1976 CALL pw_transfer(rho0_s_gs, wf_r)
1977 CALL pw_axpy(rho_core, rho0_s_gs, -1.0_dp)
1978 IF (ASSOCIATED(rhoz_cneo_s_gs)) THEN
1979 CALL pw_axpy(rhoz_cneo_s_gs, rho0_s_gs, -1.0_dp)
1980 END IF
1981 ELSE
1982 IF (ASSOCIATED(rhoz_cneo_s_gs)) THEN
1983 CALL pw_axpy(rhoz_cneo_s_gs, rho0_s_gs)
1984 END IF
1985 CALL pw_transfer(rho0_s_gs, wf_r)
1986 IF (ASSOCIATED(rhoz_cneo_s_gs)) THEN
1987 CALL pw_axpy(rhoz_cneo_s_gs, rho0_s_gs, -1.0_dp)
1988 END IF
1989 END IF
1990 ELSE
1991 CALL pw_transfer(rho_core, wf_r)
1992 END IF
1993 DO ispin = 1, dft_control%nspins
1994 CALL pw_axpy(rho_r(ispin), wf_r)
1995 END DO
1996 filename = "TOTAL_DENSITY"
1997 mpi_io = .true.
1998 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%TOT_DENSITY_CUBE", &
1999 extension=".cube", middle_name=trim(filename), file_position=my_pos_cube, &
2000 log_filename=.false., mpi_io=mpi_io)
2001 CALL cp_pw_to_cube(wf_r, unit_nr, "TOTAL DENSITY", &
2002 particles=particles, &
2003 stride=section_get_ivals(dft_section, "PRINT%TOT_DENSITY_CUBE%STRIDE"), mpi_io=mpi_io)
2004 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2005 "DFT%PRINT%TOT_DENSITY_CUBE", mpi_io=mpi_io)
2006 CALL auxbas_pw_pool%give_back_pw(wf_r)
2007 END IF
2008
2009 ! Write cube file with electron density
2010 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
2011 "DFT%PRINT%E_DENSITY_CUBE"), cp_p_file)) THEN
2012 CALL section_vals_val_get(dft_section, &
2013 keyword_name="PRINT%E_DENSITY_CUBE%DENSITY_INCLUDE", &
2014 c_val=print_density)
2015 print_density = trim(print_density)
2016 append_cube = section_get_lval(input, "DFT%PRINT%E_DENSITY_CUBE%APPEND")
2017 my_pos_cube = "REWIND"
2018 IF (append_cube) THEN
2019 my_pos_cube = "APPEND"
2020 END IF
2021 ! Write the info on core densities for the interface between cp2k and the XRD code
2022 ! together with the valence density they are used to compute the form factor (Fourier transform)
2023 xrd_interface = section_get_lval(input, "DFT%PRINT%E_DENSITY_CUBE%XRD_INTERFACE")
2024 IF (xrd_interface) THEN
2025 !cube file only contains soft density (GAPW)
2026 IF (dft_control%qs_control%gapw) print_density = "SOFT_DENSITY"
2027
2028 filename = "ELECTRON_DENSITY"
2029 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%E_DENSITY_CUBE", &
2030 extension=".xrd", middle_name=trim(filename), &
2031 file_position=my_pos_cube, log_filename=.false.)
2032 ngto = section_get_ival(input, "DFT%PRINT%E_DENSITY_CUBE%NGAUSS")
2033 IF (output_unit > 0) THEN
2034 INQUIRE (unit=unit_nr, name=filename)
2035 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2036 "The electron density (atomic part) is written to the file:", &
2037 trim(filename)
2038 END IF
2039
2040 xc_section => section_vals_get_subs_vals(input, "DFT%XC")
2041 nkind = SIZE(atomic_kind_set)
2042 IF (unit_nr > 0) THEN
2043 WRITE (unit_nr, *) "Atomic (core) densities"
2044 WRITE (unit_nr, *) "Unit cell"
2045 WRITE (unit_nr, fmt="(3F20.12)") cell%hmat(1, 1), cell%hmat(1, 2), cell%hmat(1, 3)
2046 WRITE (unit_nr, fmt="(3F20.12)") cell%hmat(2, 1), cell%hmat(2, 2), cell%hmat(2, 3)
2047 WRITE (unit_nr, fmt="(3F20.12)") cell%hmat(3, 1), cell%hmat(3, 2), cell%hmat(3, 3)
2048 WRITE (unit_nr, *) "Atomic types"
2049 WRITE (unit_nr, *) nkind
2050 END IF
2051 ! calculate atomic density and core density
2052 ALLOCATE (ppdens(ngto, 2, nkind), aedens(ngto, 2, nkind), ccdens(ngto, 2, nkind))
2053 DO ikind = 1, nkind
2054 atomic_kind => atomic_kind_set(ikind)
2055 qs_kind => qs_kind_set(ikind)
2056 CALL get_atomic_kind(atomic_kind, name=name, element_symbol=element_symbol)
2057 CALL calculate_atomic_density(ppdens(:, :, ikind), atomic_kind, qs_kind, ngto, &
2058 iunit=output_unit, confine=.true.)
2059 CALL calculate_atomic_density(aedens(:, :, ikind), atomic_kind, qs_kind, ngto, &
2060 iunit=output_unit, allelectron=.true., confine=.true.)
2061 ccdens(:, 1, ikind) = aedens(:, 1, ikind)
2062 ccdens(:, 2, ikind) = 0._dp
2063 CALL project_function_a(ccdens(1:ngto, 2, ikind), ccdens(1:ngto, 1, ikind), &
2064 ppdens(1:ngto, 2, ikind), ppdens(1:ngto, 1, ikind), 0)
2065 ccdens(:, 2, ikind) = aedens(:, 2, ikind) - ccdens(:, 2, ikind)
2066 IF (unit_nr > 0) THEN
2067 WRITE (unit_nr, fmt="(I6,A10,A20)") ikind, trim(element_symbol), trim(name)
2068 WRITE (unit_nr, fmt="(I6)") ngto
2069 WRITE (unit_nr, *) " Total density"
2070 WRITE (unit_nr, fmt="(2G24.12)") (aedens(i, 1, ikind), aedens(i, 2, ikind), i=1, ngto)
2071 WRITE (unit_nr, *) " Core density"
2072 WRITE (unit_nr, fmt="(2G24.12)") (ccdens(i, 1, ikind), ccdens(i, 2, ikind), i=1, ngto)
2073 END IF
2074 NULLIFY (atomic_kind)
2075 END DO
2076
2077 IF (dft_control%qs_control%gapw) THEN
2078 CALL get_qs_env(qs_env=qs_env, rho_atom_set=rho_atom_set)
2079
2080 IF (unit_nr > 0) THEN
2081 WRITE (unit_nr, *) "Coordinates and GAPW density"
2082 END IF
2083 np = particles%n_els
2084 DO iat = 1, np
2085 CALL get_atomic_kind(particles%els(iat)%atomic_kind, kind_number=ikind)
2086 CALL get_qs_kind(qs_kind_set(ikind), grid_atom=grid_atom)
2087 rho_atom => rho_atom_set(iat)
2088 IF (ASSOCIATED(rho_atom%rho_rad_h(1)%r_coef)) THEN
2089 nr = SIZE(rho_atom%rho_rad_h(1)%r_coef, 1)
2090 niso = SIZE(rho_atom%rho_rad_h(1)%r_coef, 2)
2091 ELSE
2092 nr = 0
2093 niso = 0
2094 END IF
2095 CALL para_env%sum(nr)
2096 CALL para_env%sum(niso)
2097
2098 ALLOCATE (bfun(nr, niso))
2099 bfun = 0._dp
2100 DO ispin = 1, dft_control%nspins
2101 IF (ASSOCIATED(rho_atom%rho_rad_h(1)%r_coef)) THEN
2102 bfun(:, :) = bfun + rho_atom%rho_rad_h(ispin)%r_coef - rho_atom%rho_rad_s(ispin)%r_coef
2103 END IF
2104 END DO
2105 CALL para_env%sum(bfun)
2106 ccdens(:, 1, ikind) = ppdens(:, 1, ikind)
2107 ccdens(:, 2, ikind) = 0._dp
2108 IF (unit_nr > 0) THEN
2109 WRITE (unit_nr, '(I10,I5,3f12.6)') iat, ikind, particles%els(iat)%r
2110 END IF
2111 DO iso = 1, niso
2112 l = indso(1, iso)
2113 CALL project_function_b(ccdens(:, 2, ikind), ccdens(:, 1, ikind), bfun(:, iso), grid_atom, l)
2114 IF (unit_nr > 0) THEN
2115 WRITE (unit_nr, fmt="(3I6)") iso, l, ngto
2116 WRITE (unit_nr, fmt="(2G24.12)") (ccdens(i, 1, ikind), ccdens(i, 2, ikind), i=1, ngto)
2117 END IF
2118 END DO
2119 DEALLOCATE (bfun)
2120 END DO
2121 ELSE
2122 IF (unit_nr > 0) THEN
2123 WRITE (unit_nr, *) "Coordinates"
2124 np = particles%n_els
2125 DO iat = 1, np
2126 CALL get_atomic_kind(particles%els(iat)%atomic_kind, kind_number=ikind)
2127 WRITE (unit_nr, '(I10,I5,3f12.6)') iat, ikind, particles%els(iat)%r
2128 END DO
2129 END IF
2130 END IF
2131
2132 DEALLOCATE (ppdens, aedens, ccdens)
2133
2134 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2135 "DFT%PRINT%E_DENSITY_CUBE")
2136
2137 END IF
2138 IF (dft_control%qs_control%gapw .AND. print_density == "TOTAL_DENSITY") THEN
2139 ! total density in g-space not implemented for k-points
2140 cpassert(.NOT. do_kpoints)
2141 ! Print total electronic density
2142 CALL get_qs_env(qs_env=qs_env, &
2143 pw_env=pw_env)
2144 CALL pw_env_get(pw_env=pw_env, &
2145 auxbas_pw_pool=auxbas_pw_pool, &
2146 pw_pools=pw_pools)
2147 CALL auxbas_pw_pool%create_pw(pw=rho_elec_rspace)
2148 CALL pw_zero(rho_elec_rspace)
2149 CALL auxbas_pw_pool%create_pw(pw=rho_elec_gspace)
2150 CALL pw_zero(rho_elec_gspace)
2151 CALL get_pw_grid_info(pw_grid=rho_elec_gspace%pw_grid, &
2152 dr=dr, &
2153 vol=volume)
2154 q_max = sqrt(sum((pi/dr(:))**2))
2155 CALL calculate_rhotot_elec_gspace(qs_env=qs_env, &
2156 auxbas_pw_pool=auxbas_pw_pool, &
2157 rhotot_elec_gspace=rho_elec_gspace, &
2158 q_max=q_max, &
2159 rho_hard=rho_hard, &
2160 rho_soft=rho_soft)
2161 rho_total = rho_hard + rho_soft
2162 CALL get_pw_grid_info(pw_grid=rho_elec_gspace%pw_grid, &
2163 vol=volume)
2164 ! rhotot pw coefficients are by default scaled by grid volume
2165 ! need to undo this to get proper charge from printed cube
2166 CALL pw_scale(rho_elec_gspace, 1.0_dp/volume)
2167
2168 CALL pw_transfer(rho_elec_gspace, rho_elec_rspace)
2169 rho_total_rspace = pw_integrate_function(rho_elec_rspace, isign=-1)
2170 filename = "TOTAL_ELECTRON_DENSITY"
2171 mpi_io = .true.
2172 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%E_DENSITY_CUBE", &
2173 extension=".cube", middle_name=trim(filename), &
2174 file_position=my_pos_cube, log_filename=.false., mpi_io=mpi_io, &
2175 fout=mpi_filename)
2176 IF (output_unit > 0) THEN
2177 IF (.NOT. mpi_io) THEN
2178 INQUIRE (unit=unit_nr, name=filename)
2179 ELSE
2180 filename = mpi_filename
2181 END IF
2182 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2183 "The total electron density is written in cube file format to the file:", &
2184 trim(filename)
2185 WRITE (unit=output_unit, fmt="(/,(T2,A,F20.10))") &
2186 "q(max) [1/Angstrom] :", q_max/angstrom, &
2187 "Soft electronic charge (G-space) :", rho_soft, &
2188 "Hard electronic charge (G-space) :", rho_hard, &
2189 "Total electronic charge (G-space):", rho_total, &
2190 "Total electronic charge (R-space):", rho_total_rspace
2191 END IF
2192 CALL cp_pw_to_cube(rho_elec_rspace, unit_nr, "TOTAL ELECTRON DENSITY", &
2193 particles=particles, &
2194 stride=section_get_ivals(dft_section, "PRINT%E_DENSITY_CUBE%STRIDE"), mpi_io=mpi_io)
2195 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2196 "DFT%PRINT%E_DENSITY_CUBE", mpi_io=mpi_io)
2197 ! Print total spin density for spin-polarized systems
2198 IF (dft_control%nspins > 1) THEN
2199 CALL pw_zero(rho_elec_gspace)
2200 CALL pw_zero(rho_elec_rspace)
2201 CALL calculate_rhotot_elec_gspace(qs_env=qs_env, &
2202 auxbas_pw_pool=auxbas_pw_pool, &
2203 rhotot_elec_gspace=rho_elec_gspace, &
2204 q_max=q_max, &
2205 rho_hard=rho_hard, &
2206 rho_soft=rho_soft, &
2207 fsign=-1.0_dp)
2208 rho_total = rho_hard + rho_soft
2209
2210 ! rhotot pw coefficients are by default scaled by grid volume
2211 ! need to undo this to get proper charge from printed cube
2212 CALL pw_scale(rho_elec_gspace, 1.0_dp/volume)
2213
2214 CALL pw_transfer(rho_elec_gspace, rho_elec_rspace)
2215 rho_total_rspace = pw_integrate_function(rho_elec_rspace, isign=-1)
2216 filename = "TOTAL_SPIN_DENSITY"
2217 mpi_io = .true.
2218 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%E_DENSITY_CUBE", &
2219 extension=".cube", middle_name=trim(filename), &
2220 file_position=my_pos_cube, log_filename=.false., mpi_io=mpi_io, &
2221 fout=mpi_filename)
2222 IF (output_unit > 0) THEN
2223 IF (.NOT. mpi_io) THEN
2224 INQUIRE (unit=unit_nr, name=filename)
2225 ELSE
2226 filename = mpi_filename
2227 END IF
2228 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2229 "The total spin density is written in cube file format to the file:", &
2230 trim(filename)
2231 WRITE (unit=output_unit, fmt="(/,(T2,A,F20.10))") &
2232 "q(max) [1/Angstrom] :", q_max/angstrom, &
2233 "Soft part of the spin density (G-space):", rho_soft, &
2234 "Hard part of the spin density (G-space):", rho_hard, &
2235 "Total spin density (G-space) :", rho_total, &
2236 "Total spin density (R-space) :", rho_total_rspace
2237 END IF
2238 CALL cp_pw_to_cube(rho_elec_rspace, unit_nr, "TOTAL SPIN DENSITY", &
2239 particles=particles, &
2240 stride=section_get_ivals(dft_section, "PRINT%E_DENSITY_CUBE%STRIDE"), mpi_io=mpi_io)
2241 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2242 "DFT%PRINT%E_DENSITY_CUBE", mpi_io=mpi_io)
2243 END IF
2244 CALL auxbas_pw_pool%give_back_pw(rho_elec_gspace)
2245 CALL auxbas_pw_pool%give_back_pw(rho_elec_rspace)
2246
2247 ELSE IF (print_density == "SOFT_DENSITY" .OR. .NOT. dft_control%qs_control%gapw) THEN
2248 IF (dft_control%nspins > 1) THEN
2249 CALL get_qs_env(qs_env=qs_env, &
2250 pw_env=pw_env)
2251 CALL pw_env_get(pw_env=pw_env, &
2252 auxbas_pw_pool=auxbas_pw_pool, &
2253 pw_pools=pw_pools)
2254 CALL auxbas_pw_pool%create_pw(pw=rho_elec_rspace)
2255 CALL pw_copy(rho_r(1), rho_elec_rspace)
2256 CALL pw_axpy(rho_r(2), rho_elec_rspace)
2257 filename = "ELECTRON_DENSITY"
2258 mpi_io = .true.
2259 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%E_DENSITY_CUBE", &
2260 extension=".cube", middle_name=trim(filename), &
2261 file_position=my_pos_cube, log_filename=.false., mpi_io=mpi_io, &
2262 fout=mpi_filename)
2263 IF (output_unit > 0) THEN
2264 IF (.NOT. mpi_io) THEN
2265 INQUIRE (unit=unit_nr, name=filename)
2266 ELSE
2267 filename = mpi_filename
2268 END IF
2269 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2270 "The sum of alpha and beta density is written in cube file format to the file:", &
2271 trim(filename)
2272 END IF
2273 CALL cp_pw_to_cube(rho_elec_rspace, unit_nr, "SUM OF ALPHA AND BETA DENSITY", &
2274 particles=particles, stride=section_get_ivals(dft_section, "PRINT%E_DENSITY_CUBE%STRIDE"), &
2275 mpi_io=mpi_io)
2276 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2277 "DFT%PRINT%E_DENSITY_CUBE", mpi_io=mpi_io)
2278 CALL pw_copy(rho_r(1), rho_elec_rspace)
2279 CALL pw_axpy(rho_r(2), rho_elec_rspace, alpha=-1.0_dp)
2280 filename = "SPIN_DENSITY"
2281 mpi_io = .true.
2282 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%E_DENSITY_CUBE", &
2283 extension=".cube", middle_name=trim(filename), &
2284 file_position=my_pos_cube, log_filename=.false., mpi_io=mpi_io, &
2285 fout=mpi_filename)
2286 IF (output_unit > 0) THEN
2287 IF (.NOT. mpi_io) THEN
2288 INQUIRE (unit=unit_nr, name=filename)
2289 ELSE
2290 filename = mpi_filename
2291 END IF
2292 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2293 "The spin density is written in cube file format to the file:", &
2294 trim(filename)
2295 END IF
2296 CALL cp_pw_to_cube(rho_elec_rspace, unit_nr, "SPIN DENSITY", &
2297 particles=particles, &
2298 stride=section_get_ivals(dft_section, "PRINT%E_DENSITY_CUBE%STRIDE"), mpi_io=mpi_io)
2299 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2300 "DFT%PRINT%E_DENSITY_CUBE", mpi_io=mpi_io)
2301 CALL auxbas_pw_pool%give_back_pw(rho_elec_rspace)
2302 ELSE
2303 filename = "ELECTRON_DENSITY"
2304 mpi_io = .true.
2305 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%E_DENSITY_CUBE", &
2306 extension=".cube", middle_name=trim(filename), &
2307 file_position=my_pos_cube, log_filename=.false., mpi_io=mpi_io, &
2308 fout=mpi_filename)
2309 IF (output_unit > 0) THEN
2310 IF (.NOT. mpi_io) THEN
2311 INQUIRE (unit=unit_nr, name=filename)
2312 ELSE
2313 filename = mpi_filename
2314 END IF
2315 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2316 "The electron density is written in cube file format to the file:", &
2317 trim(filename)
2318 END IF
2319 CALL cp_pw_to_cube(rho_r(1), unit_nr, "ELECTRON DENSITY", &
2320 particles=particles, &
2321 stride=section_get_ivals(dft_section, "PRINT%E_DENSITY_CUBE%STRIDE"), mpi_io=mpi_io)
2322 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2323 "DFT%PRINT%E_DENSITY_CUBE", mpi_io=mpi_io)
2324 END IF ! nspins
2325
2326 ELSE IF (dft_control%qs_control%gapw .AND. print_density == "TOTAL_HARD_APPROX") THEN
2327 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, rho0_mpole=rho0_mpole, natom=natom)
2328 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, pw_pools=pw_pools)
2329 CALL auxbas_pw_pool%create_pw(rho_elec_rspace)
2330
2331 NULLIFY (my_q0)
2332 ALLOCATE (my_q0(natom))
2333 my_q0 = 0.0_dp
2334
2335 ! (eta/pi)**3: normalization for 3d gaussian of form exp(-eta*r**2)
2336 norm_factor = sqrt((rho0_mpole%zet0_h/pi)**3)
2337
2338 ! store hard part of electronic density in array
2339 DO iat = 1, natom
2340 my_q0(iat) = sum(rho0_mpole%mp_rho(iat)%Q0(1:dft_control%nspins))*norm_factor
2341 END DO
2342 ! multiply coeff with gaussian and put on realspace grid
2343 ! coeff is the gaussian prefactor, eta the gaussian exponent
2344 CALL calculate_rho_resp_all(rho_elec_rspace, coeff=my_q0, natom=natom, eta=rho0_mpole%zet0_h, qs_env=qs_env)
2345 rho_hard = pw_integrate_function(rho_elec_rspace, isign=-1)
2346
2347 rho_soft = 0.0_dp
2348 DO ispin = 1, dft_control%nspins
2349 CALL pw_axpy(rho_r(ispin), rho_elec_rspace)
2350 rho_soft = rho_soft + pw_integrate_function(rho_r(ispin), isign=-1)
2351 END DO
2352
2353 rho_total_rspace = rho_soft + rho_hard
2354
2355 filename = "ELECTRON_DENSITY"
2356 mpi_io = .true.
2357 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%E_DENSITY_CUBE", &
2358 extension=".cube", middle_name=trim(filename), &
2359 file_position=my_pos_cube, log_filename=.false., mpi_io=mpi_io, &
2360 fout=mpi_filename)
2361 IF (output_unit > 0) THEN
2362 IF (.NOT. mpi_io) THEN
2363 INQUIRE (unit=unit_nr, name=filename)
2364 ELSE
2365 filename = mpi_filename
2366 END IF
2367 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2368 "The electron density is written in cube file format to the file:", &
2369 trim(filename)
2370 WRITE (unit=output_unit, fmt="(/,(T2,A,F20.10))") &
2371 "Soft electronic charge (R-space) :", rho_soft, &
2372 "Hard electronic charge (R-space) :", rho_hard, &
2373 "Total electronic charge (R-space):", rho_total_rspace
2374 END IF
2375 CALL cp_pw_to_cube(rho_elec_rspace, unit_nr, "ELECTRON DENSITY", &
2376 particles=particles, stride=section_get_ivals(dft_section, "PRINT%E_DENSITY_CUBE%STRIDE"), &
2377 mpi_io=mpi_io)
2378 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2379 "DFT%PRINT%E_DENSITY_CUBE", mpi_io=mpi_io)
2380
2381 !------------
2382 IF (dft_control%nspins > 1) THEN
2383 DO iat = 1, natom
2384 my_q0(iat) = (rho0_mpole%mp_rho(iat)%Q0(1) - rho0_mpole%mp_rho(iat)%Q0(2))*norm_factor
2385 END DO
2386 CALL pw_zero(rho_elec_rspace)
2387 CALL calculate_rho_resp_all(rho_elec_rspace, coeff=my_q0, natom=natom, eta=rho0_mpole%zet0_h, qs_env=qs_env)
2388 rho_hard = pw_integrate_function(rho_elec_rspace, isign=-1)
2389
2390 CALL pw_axpy(rho_r(1), rho_elec_rspace)
2391 CALL pw_axpy(rho_r(2), rho_elec_rspace, alpha=-1.0_dp)
2392 rho_soft = pw_integrate_function(rho_r(1), isign=-1) &
2393 - pw_integrate_function(rho_r(2), isign=-1)
2394
2395 rho_total_rspace = rho_soft + rho_hard
2396
2397 filename = "SPIN_DENSITY"
2398 mpi_io = .true.
2399 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%E_DENSITY_CUBE", &
2400 extension=".cube", middle_name=trim(filename), &
2401 file_position=my_pos_cube, log_filename=.false., mpi_io=mpi_io, &
2402 fout=mpi_filename)
2403 IF (output_unit > 0) THEN
2404 IF (.NOT. mpi_io) THEN
2405 INQUIRE (unit=unit_nr, name=filename)
2406 ELSE
2407 filename = mpi_filename
2408 END IF
2409 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2410 "The spin density is written in cube file format to the file:", &
2411 trim(filename)
2412 WRITE (unit=output_unit, fmt="(/,(T2,A,F20.10))") &
2413 "Soft part of the spin density :", rho_soft, &
2414 "Hard part of the spin density :", rho_hard, &
2415 "Total spin density (R-space) :", rho_total_rspace
2416 END IF
2417 CALL cp_pw_to_cube(rho_elec_rspace, unit_nr, "SPIN DENSITY", &
2418 particles=particles, &
2419 stride=section_get_ivals(dft_section, "PRINT%E_DENSITY_CUBE%STRIDE"), mpi_io=mpi_io)
2420 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2421 "DFT%PRINT%E_DENSITY_CUBE", mpi_io=mpi_io)
2422 END IF ! nspins
2423 CALL auxbas_pw_pool%give_back_pw(rho_elec_rspace)
2424 DEALLOCATE (my_q0)
2425 END IF ! print_density
2426 END IF ! print key
2427
2428 IF (btest(cp_print_key_should_output(logger%iter_info, &
2429 dft_section, "PRINT%ENERGY_WINDOWS"), cp_p_file) .AND. .NOT. do_kpoints) THEN
2430 CALL energy_windows(qs_env)
2431 END IF
2432
2433 ! Print the hartree potential
2434 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
2435 "DFT%PRINT%V_HARTREE_CUBE"), cp_p_file)) THEN
2436
2437 CALL get_qs_env(qs_env=qs_env, &
2438 pw_env=pw_env, &
2439 v_hartree_rspace=v_hartree_rspace)
2440 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
2441 CALL auxbas_pw_pool%create_pw(aux_r)
2442
2443 append_cube = section_get_lval(input, "DFT%PRINT%V_HARTREE_CUBE%APPEND")
2444 my_pos_cube = "REWIND"
2445 IF (append_cube) THEN
2446 my_pos_cube = "APPEND"
2447 END IF
2448 mpi_io = .true.
2449 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
2450 CALL pw_env_get(pw_env)
2451 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%V_HARTREE_CUBE", &
2452 extension=".cube", middle_name="v_hartree", file_position=my_pos_cube, mpi_io=mpi_io)
2453 udvol = 1.0_dp/v_hartree_rspace%pw_grid%dvol
2454
2455 CALL pw_copy(v_hartree_rspace, aux_r)
2456 CALL pw_scale(aux_r, udvol)
2457
2458 CALL cp_pw_to_cube(aux_r, unit_nr, "HARTREE POTENTIAL", particles=particles, &
2459 stride=section_get_ivals(dft_section, &
2460 "PRINT%V_HARTREE_CUBE%STRIDE"), mpi_io=mpi_io)
2461 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2462 "DFT%PRINT%V_HARTREE_CUBE", mpi_io=mpi_io)
2463
2464 CALL auxbas_pw_pool%give_back_pw(aux_r)
2465 END IF
2466
2467 ! Print the external potential
2468 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
2469 "DFT%PRINT%EXTERNAL_POTENTIAL_CUBE"), cp_p_file)) THEN
2470 IF (dft_control%apply_external_potential) THEN
2471 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, vee=vee)
2472 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
2473 CALL auxbas_pw_pool%create_pw(aux_r)
2474
2475 append_cube = section_get_lval(input, "DFT%PRINT%EXTERNAL_POTENTIAL_CUBE%APPEND")
2476 my_pos_cube = "REWIND"
2477 IF (append_cube) THEN
2478 my_pos_cube = "APPEND"
2479 END IF
2480 mpi_io = .true.
2481 CALL pw_env_get(pw_env)
2482 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%EXTERNAL_POTENTIAL_CUBE", &
2483 extension=".cube", middle_name="ext_pot", file_position=my_pos_cube, mpi_io=mpi_io)
2484
2485 CALL pw_copy(vee, aux_r)
2486
2487 CALL cp_pw_to_cube(aux_r, unit_nr, "EXTERNAL POTENTIAL", particles=particles, &
2488 stride=section_get_ivals(dft_section, &
2489 "PRINT%EXTERNAL_POTENTIAL_CUBE%STRIDE"), mpi_io=mpi_io)
2490 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2491 "DFT%PRINT%EXTERNAL_POTENTIAL_CUBE", mpi_io=mpi_io)
2492
2493 CALL auxbas_pw_pool%give_back_pw(aux_r)
2494 END IF
2495 END IF
2496
2497 ! Print the Electrical Field Components
2498 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
2499 "DFT%PRINT%EFIELD_CUBE"), cp_p_file)) THEN
2500
2501 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
2502 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
2503 CALL auxbas_pw_pool%create_pw(aux_r)
2504 CALL auxbas_pw_pool%create_pw(aux_g)
2505
2506 append_cube = section_get_lval(input, "DFT%PRINT%EFIELD_CUBE%APPEND")
2507 my_pos_cube = "REWIND"
2508 IF (append_cube) THEN
2509 my_pos_cube = "APPEND"
2510 END IF
2511 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, &
2512 v_hartree_rspace=v_hartree_rspace)
2513 CALL pw_env_get(pw_env)
2514 udvol = 1.0_dp/v_hartree_rspace%pw_grid%dvol
2515 DO id = 1, 3
2516 mpi_io = .true.
2517 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%EFIELD_CUBE", &
2518 extension=".cube", middle_name="efield_"//cdir(id), file_position=my_pos_cube, &
2519 mpi_io=mpi_io)
2520
2521 CALL pw_transfer(v_hartree_rspace, aux_g)
2522 nd = 0
2523 nd(id) = 1
2524 CALL pw_derive(aux_g, nd)
2525 CALL pw_transfer(aux_g, aux_r)
2526 CALL pw_scale(aux_r, udvol)
2527
2528 CALL cp_pw_to_cube(aux_r, &
2529 unit_nr, "ELECTRIC FIELD", particles=particles, &
2530 stride=section_get_ivals(dft_section, &
2531 "PRINT%EFIELD_CUBE%STRIDE"), mpi_io=mpi_io)
2532 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2533 "DFT%PRINT%EFIELD_CUBE", mpi_io=mpi_io)
2534 END DO
2535
2536 CALL auxbas_pw_pool%give_back_pw(aux_r)
2537 CALL auxbas_pw_pool%give_back_pw(aux_g)
2538 END IF
2539
2540 ! Write cube files from the local energy
2541 CALL qs_scf_post_local_energy(input, logger, qs_env)
2542
2543 ! Write cube files from the local stress tensor
2544 CALL qs_scf_post_local_stress(input, logger, qs_env)
2545
2546 ! Write cube files from the implicit Poisson solver
2547 CALL qs_scf_post_ps_implicit(input, logger, qs_env)
2548
2549 ! post SCF Transport
2550 CALL qs_scf_post_transport(qs_env)
2551
2552 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%OMIT_HEADERS", l_val=omit_headers)
2553 ! Write the density matrices
2554 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
2555 "DFT%PRINT%AO_MATRICES/DENSITY"), cp_p_file)) THEN
2556 iw = cp_print_key_unit_nr(logger, input, "DFT%PRINT%AO_MATRICES/DENSITY", &
2557 extension=".Log")
2558 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
2559 CALL qs_rho_get(rho, rho_ao_kp=rho_ao)
2560 after = min(max(after, 1), 16)
2561 DO ispin = 1, dft_control%nspins
2562 DO img = 1, dft_control%nimages
2563 CALL cp_dbcsr_write_sparse_matrix(rho_ao(ispin, img)%matrix, 4, after, qs_env, &
2564 para_env, output_unit=iw, omit_headers=omit_headers)
2565 END DO
2566 END DO
2567 CALL cp_print_key_finished_output(iw, logger, input, &
2568 "DFT%PRINT%AO_MATRICES/DENSITY")
2569 END IF
2570
2571 ! Write the Kohn-Sham matrices
2572 write_ks = btest(cp_print_key_should_output(logger%iter_info, input, &
2573 "DFT%PRINT%AO_MATRICES/KOHN_SHAM_MATRIX"), cp_p_file)
2574 write_xc = btest(cp_print_key_should_output(logger%iter_info, input, &
2575 "DFT%PRINT%AO_MATRICES/MATRIX_VXC"), cp_p_file)
2576 ! we need to update stuff before writing, potentially computing the matrix_vxc
2577 IF (write_ks .OR. write_xc) THEN
2578 IF (write_xc) qs_env%requires_matrix_vxc = .true.
2579 CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.true.)
2580 CALL qs_ks_update_qs_env(qs_env, calculate_forces=.false., &
2581 just_energy=.false.)
2582 IF (write_xc) qs_env%requires_matrix_vxc = .false.
2583 END IF
2584
2585 ! Write the Kohn-Sham matrices
2586 IF (write_ks) THEN
2587 iw = cp_print_key_unit_nr(logger, input, "DFT%PRINT%AO_MATRICES/KOHN_SHAM_MATRIX", &
2588 extension=".Log")
2589 CALL get_qs_env(qs_env=qs_env, matrix_ks_kp=ks_rmpv)
2590 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
2591 after = min(max(after, 1), 16)
2592 DO ispin = 1, dft_control%nspins
2593 DO img = 1, dft_control%nimages
2594 CALL cp_dbcsr_write_sparse_matrix(ks_rmpv(ispin, img)%matrix, 4, after, qs_env, &
2595 para_env, output_unit=iw, omit_headers=omit_headers)
2596 END DO
2597 END DO
2598 CALL cp_print_key_finished_output(iw, logger, input, &
2599 "DFT%PRINT%AO_MATRICES/KOHN_SHAM_MATRIX")
2600 END IF
2601
2602 ! write csr matrices
2603 ! matrices in terms of the PAO basis will be taken care of in pao_post_scf.
2604 IF (.NOT. dft_control%qs_control%pao) THEN
2605 CALL write_ks_matrix_csr(qs_env, input)
2606 CALL write_s_matrix_csr(qs_env, input)
2607 END IF
2608
2609 ! write adjacency matrix
2610 CALL write_adjacency_matrix(qs_env, input)
2611
2612 ! Write the xc matrix
2613 IF (write_xc) THEN
2614 CALL get_qs_env(qs_env=qs_env, matrix_vxc_kp=matrix_vxc)
2615 cpassert(ASSOCIATED(matrix_vxc))
2616 iw = cp_print_key_unit_nr(logger, input, "DFT%PRINT%AO_MATRICES/MATRIX_VXC", &
2617 extension=".Log")
2618 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
2619 after = min(max(after, 1), 16)
2620 DO ispin = 1, dft_control%nspins
2621 DO img = 1, dft_control%nimages
2622 CALL cp_dbcsr_write_sparse_matrix(matrix_vxc(ispin, img)%matrix, 4, after, qs_env, &
2623 para_env, output_unit=iw, omit_headers=omit_headers)
2624 END DO
2625 END DO
2626 CALL cp_print_key_finished_output(iw, logger, input, &
2627 "DFT%PRINT%AO_MATRICES/MATRIX_VXC")
2628 END IF
2629
2630 ! Write the [H,r] commutator matrices
2631 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
2632 "DFT%PRINT%AO_MATRICES/COMMUTATOR_HR"), cp_p_file)) THEN
2633 iw = cp_print_key_unit_nr(logger, input, "DFT%PRINT%AO_MATRICES/COMMUTATOR_HR", &
2634 extension=".Log")
2635 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
2636 NULLIFY (matrix_hr)
2637 CALL build_com_hr_matrix(qs_env, matrix_hr)
2638 after = min(max(after, 1), 16)
2639 DO img = 1, 3
2640 CALL cp_dbcsr_write_sparse_matrix(matrix_hr(img)%matrix, 4, after, qs_env, &
2641 para_env, output_unit=iw, omit_headers=omit_headers)
2642 END DO
2643 CALL dbcsr_deallocate_matrix_set(matrix_hr)
2644 CALL cp_print_key_finished_output(iw, logger, input, &
2645 "DFT%PRINT%AO_MATRICES/COMMUTATOR_HR")
2646 END IF
2647
2648 ! Compute the Mulliken charges
2649 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%MULLIKEN")
2650 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
2651 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MULLIKEN", extension=".mulliken", log_filename=.false.)
2652 print_level = 1
2653 CALL section_vals_val_get(print_key, "PRINT_GOP", l_val=print_it)
2654 IF (print_it) print_level = 2
2655 CALL section_vals_val_get(print_key, "PRINT_ALL", l_val=print_it)
2656 IF (print_it) print_level = 3
2657 CALL mulliken_population_analysis(qs_env, unit_nr, print_level)
2658 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MULLIKEN")
2659 END IF
2660
2661 ! Compute the Hirshfeld charges
2662 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%HIRSHFELD")
2663 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
2664 ! we check if real space density is available
2665 NULLIFY (rho)
2666 CALL get_qs_env(qs_env=qs_env, rho=rho)
2667 CALL qs_rho_get(rho, rho_r_valid=rho_r_valid)
2668 IF (rho_r_valid) THEN
2669 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%HIRSHFELD", extension=".hirshfeld", log_filename=.false.)
2670 CALL hirshfeld_charges(qs_env, print_key, unit_nr)
2671 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%HIRSHFELD")
2672 END IF
2673 END IF
2674
2675 ! Compute EEQ charges
2676 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%EEQ_CHARGES")
2677 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
2678 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%EEQ_CHARGES", extension=".eeq", log_filename=.false.)
2679 print_level = 1
2680 CALL eeq_print(qs_env, unit_nr, print_level, ext=.false.)
2681 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MULLIKEN")
2682 END IF
2683
2684 ! Do a Voronoi Integration or write a compressed BQB File
2685 print_key_voro => section_vals_get_subs_vals(input, "DFT%PRINT%VORONOI")
2686 print_key_bqb => section_vals_get_subs_vals(input, "DFT%PRINT%E_DENSITY_BQB")
2687 IF (btest(cp_print_key_should_output(logger%iter_info, print_key_voro), cp_p_file)) THEN
2688 should_print_voro = 1
2689 ELSE
2690 should_print_voro = 0
2691 END IF
2692 IF (btest(cp_print_key_should_output(logger%iter_info, print_key_bqb), cp_p_file)) THEN
2693 should_print_bqb = 1
2694 ELSE
2695 should_print_bqb = 0
2696 END IF
2697 IF ((should_print_voro /= 0) .OR. (should_print_bqb /= 0)) THEN
2698
2699 ! we check if real space density is available
2700 NULLIFY (rho)
2701 CALL get_qs_env(qs_env=qs_env, rho=rho)
2702 CALL qs_rho_get(rho, rho_r_valid=rho_r_valid)
2703 IF (rho_r_valid) THEN
2704
2705 IF (dft_control%nspins > 1) THEN
2706 CALL get_qs_env(qs_env=qs_env, &
2707 pw_env=pw_env)
2708 CALL pw_env_get(pw_env=pw_env, &
2709 auxbas_pw_pool=auxbas_pw_pool, &
2710 pw_pools=pw_pools)
2711 NULLIFY (mb_rho)
2712 ALLOCATE (mb_rho)
2713 CALL auxbas_pw_pool%create_pw(pw=mb_rho)
2714 CALL pw_copy(rho_r(1), mb_rho)
2715 CALL pw_axpy(rho_r(2), mb_rho)
2716 !CALL voronoi_analysis(qs_env, rho_elec_rspace, print_key, unit_nr)
2717 ELSE
2718 mb_rho => rho_r(1)
2719 !CALL voronoi_analysis( qs_env, rho_r(1), print_key, unit_nr )
2720 END IF ! nspins
2721
2722 IF (should_print_voro /= 0) THEN
2723 CALL section_vals_val_get(print_key_voro, "OUTPUT_TEXT", l_val=voro_print_txt)
2724 IF (voro_print_txt) THEN
2725 append_voro = section_get_lval(input, "DFT%PRINT%VORONOI%APPEND")
2726 my_pos_voro = "REWIND"
2727 IF (append_voro) THEN
2728 my_pos_voro = "APPEND"
2729 END IF
2730 unit_nr_voro = cp_print_key_unit_nr(logger, input, "DFT%PRINT%VORONOI", extension=".voronoi", &
2731 file_position=my_pos_voro, log_filename=.false.)
2732 ELSE
2733 unit_nr_voro = 0
2734 END IF
2735 ELSE
2736 unit_nr_voro = 0
2737 END IF
2738
2739 CALL entry_voronoi_or_bqb(should_print_voro, should_print_bqb, print_key_voro, print_key_bqb, &
2740 unit_nr_voro, qs_env, mb_rho)
2741
2742 IF (dft_control%nspins > 1) THEN
2743 CALL auxbas_pw_pool%give_back_pw(mb_rho)
2744 DEALLOCATE (mb_rho)
2745 END IF
2746
2747 IF (unit_nr_voro > 0) THEN
2748 CALL cp_print_key_finished_output(unit_nr_voro, logger, input, "DFT%PRINT%VORONOI")
2749 END IF
2750
2751 END IF
2752 END IF
2753
2754 ! MAO analysis
2755 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%MAO_ANALYSIS")
2756 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
2757 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MAO_ANALYSIS", extension=".mao", log_filename=.false.)
2758 CALL mao_analysis(qs_env, print_key, unit_nr)
2759 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MAO_ANALYSIS")
2760 END IF
2761
2762 ! MINBAS analysis
2763 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%MINBAS_ANALYSIS")
2764 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
2765 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MINBAS_ANALYSIS", extension=".mao", log_filename=.false.)
2766 CALL minbas_analysis(qs_env, print_key, unit_nr)
2767 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MINBAS_ANALYSIS")
2768 END IF
2769
2770 ! IAO analysis
2771 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%IAO_ANALYSIS")
2772 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
2773 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%IAO_ANALYSIS", extension=".iao", log_filename=.false.)
2774 CALL iao_read_input(iao_env, print_key, cell)
2775 IF (iao_env%do_iao) THEN
2776 CALL iao_wfn_analysis(qs_env, iao_env, unit_nr)
2777 END IF
2778 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%IAO_ANALYSIS")
2779 END IF
2780
2781 ! Energy Decomposition Analysis
2782 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%ENERGY_DECOMPOSITION_ANALYSIS")
2783 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
2784 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%ENERGY_DECOMPOSITION_ANALYSIS", &
2785 extension=".mao", log_filename=.false.)
2786 CALL edmf_analysis(qs_env, print_key, unit_nr)
2787 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%ENERGY_DECOMPOSITION_ANALYSIS")
2788 END IF
2789
2790 ! Print the density in the RI-HFX basis
2791 hfx_section => section_vals_get_subs_vals(input, "DFT%XC%HF")
2792 CALL section_vals_get(hfx_section, explicit=do_hfx)
2793 CALL section_vals_get(hfx_section, n_repetition=n_rep_hf)
2794 IF (do_hfx) THEN
2795 DO i = 1, n_rep_hf
2796 IF (qs_env%x_data(i, 1)%do_hfx_ri) CALL print_ri_hfx(qs_env%x_data(i, 1)%ri_data, qs_env)
2797 END DO
2798 END IF
2799
2800 CALL timestop(handle)
2801
2802 END SUBROUTINE write_mo_free_results
2803
2804! **************************************************************************************************
2805!> \brief Calculates Hirshfeld charges
2806!> \param qs_env the qs_env where to calculate the charges
2807!> \param input_section the input section for Hirshfeld charges
2808!> \param unit_nr the output unit number
2809! **************************************************************************************************
2810 SUBROUTINE hirshfeld_charges(qs_env, input_section, unit_nr)
2811 TYPE(qs_environment_type), POINTER :: qs_env
2812 TYPE(section_vals_type), POINTER :: input_section
2813 INTEGER, INTENT(IN) :: unit_nr
2814
2815 INTEGER :: i, iat, ikind, natom, nkind, nspin, &
2816 radius_type, refc, shapef
2817 INTEGER, DIMENSION(:), POINTER :: atom_list
2818 LOGICAL :: do_radius, do_sc, paw_atom
2819 REAL(kind=dp) :: zeff
2820 REAL(kind=dp), DIMENSION(:), POINTER :: radii
2821 REAL(kind=dp), DIMENSION(:, :), POINTER :: charges
2822 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
2823 TYPE(atomic_kind_type), POINTER :: atomic_kind
2824 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_p, matrix_s
2825 TYPE(dft_control_type), POINTER :: dft_control
2826 TYPE(hirshfeld_type), POINTER :: hirshfeld_env
2827 TYPE(mp_para_env_type), POINTER :: para_env
2828 TYPE(mpole_rho_atom), DIMENSION(:), POINTER :: mp_rho
2829 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
2830 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
2831 TYPE(qs_rho_type), POINTER :: rho
2832 TYPE(rho0_mpole_type), POINTER :: rho0_mpole
2833
2834 NULLIFY (hirshfeld_env)
2835 NULLIFY (radii)
2836 CALL create_hirshfeld_type(hirshfeld_env)
2837 !
2838 CALL get_qs_env(qs_env, nkind=nkind, natom=natom)
2839 ALLOCATE (hirshfeld_env%charges(natom))
2840 ! input options
2841 CALL section_vals_val_get(input_section, "SELF_CONSISTENT", l_val=do_sc)
2842 CALL section_vals_val_get(input_section, "USER_RADIUS", l_val=do_radius)
2843 CALL section_vals_val_get(input_section, "SHAPE_FUNCTION", i_val=shapef)
2844 CALL section_vals_val_get(input_section, "REFERENCE_CHARGE", i_val=refc)
2845 IF (do_radius) THEN
2846 radius_type = radius_user
2847 CALL section_vals_val_get(input_section, "ATOMIC_RADII", r_vals=radii)
2848 IF (.NOT. SIZE(radii) == nkind) &
2849 CALL cp_abort(__location__, &
2850 "Length of keyword HIRSHFELD\ATOMIC_RADII does not "// &
2851 "match number of atomic kinds in the input coordinate file.")
2852 ELSE
2853 radius_type = radius_covalent
2854 END IF
2855 CALL set_hirshfeld_info(hirshfeld_env, shape_function_type=shapef, &
2856 iterative=do_sc, ref_charge=refc, &
2857 radius_type=radius_type)
2858 ! shape function
2859 CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, atomic_kind_set=atomic_kind_set)
2860 CALL create_shape_function(hirshfeld_env, qs_kind_set, atomic_kind_set, &
2861 radii_list=radii)
2862 ! reference charges
2863 CALL get_qs_env(qs_env, rho=rho)
2864 CALL qs_rho_get(rho, rho_ao_kp=matrix_p)
2865 nspin = SIZE(matrix_p, 1)
2866 ALLOCATE (charges(natom, nspin))
2867 SELECT CASE (refc)
2868 CASE (ref_charge_atomic)
2869 DO ikind = 1, nkind
2870 CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff)
2871 atomic_kind => atomic_kind_set(ikind)
2872 CALL get_atomic_kind(atomic_kind, atom_list=atom_list)
2873 DO iat = 1, SIZE(atom_list)
2874 i = atom_list(iat)
2875 hirshfeld_env%charges(i) = zeff
2876 END DO
2877 END DO
2878 CASE (ref_charge_mulliken)
2879 CALL get_qs_env(qs_env, matrix_s_kp=matrix_s, para_env=para_env)
2880 CALL mulliken_charges(matrix_p, matrix_s, para_env, charges)
2881 DO iat = 1, natom
2882 hirshfeld_env%charges(iat) = sum(charges(iat, :))
2883 END DO
2884 CASE DEFAULT
2885 cpabort("Unknown type of reference charge for Hirshfeld partitioning.")
2886 END SELECT
2887 !
2888 charges = 0.0_dp
2889 IF (hirshfeld_env%iterative) THEN
2890 ! Hirshfeld-I charges
2891 CALL comp_hirshfeld_i_charges(qs_env, hirshfeld_env, charges, unit_nr)
2892 ELSE
2893 ! Hirshfeld charges
2894 CALL comp_hirshfeld_charges(qs_env, hirshfeld_env, charges)
2895 END IF
2896 CALL get_qs_env(qs_env, particle_set=particle_set, dft_control=dft_control)
2897 IF (dft_control%qs_control%gapw) THEN
2898 ! GAPW: add core charges (rho_hard - rho_soft)
2899 CALL get_qs_env(qs_env, rho0_mpole=rho0_mpole)
2900 CALL get_rho0_mpole(rho0_mpole, mp_rho=mp_rho)
2901 DO iat = 1, natom
2902 atomic_kind => particle_set(iat)%atomic_kind
2903 CALL get_atomic_kind(atomic_kind, kind_number=ikind)
2904 CALL get_qs_kind(qs_kind_set(ikind), paw_atom=paw_atom)
2905 IF (paw_atom) THEN
2906 charges(iat, 1:nspin) = charges(iat, 1:nspin) + mp_rho(iat)%q0(1:nspin)
2907 END IF
2908 END DO
2909 END IF
2910 !
2911 IF (unit_nr > 0) THEN
2912 CALL write_hirshfeld_charges(charges, hirshfeld_env, particle_set, &
2913 qs_kind_set, unit_nr)
2914 END IF
2915 ! Save the charges to the results under the tag [HIRSHFELD-CHARGES]
2916 CALL save_hirshfeld_charges(charges, particle_set, qs_kind_set, qs_env)
2917 !
2918 CALL release_hirshfeld_type(hirshfeld_env)
2919 DEALLOCATE (charges)
2920
2921 END SUBROUTINE hirshfeld_charges
2922
2923! **************************************************************************************************
2924!> \brief ...
2925!> \param ca ...
2926!> \param a ...
2927!> \param cb ...
2928!> \param b ...
2929!> \param l ...
2930! **************************************************************************************************
2931 SUBROUTINE project_function_a(ca, a, cb, b, l)
2932 ! project function cb on ca
2933 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: ca
2934 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: a, cb, b
2935 INTEGER, INTENT(IN) :: l
2936
2937 INTEGER :: info, n
2938 INTEGER, ALLOCATABLE, DIMENSION(:) :: ipiv
2939 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: smat, tmat, v
2940
2941 n = SIZE(ca)
2942 ALLOCATE (smat(n, n), tmat(n, n), v(n, 1), ipiv(n))
2943
2944 CALL sg_overlap(smat, l, a, a)
2945 CALL sg_overlap(tmat, l, a, b)
2946 v(:, 1) = matmul(tmat, cb)
2947 CALL dgesv(n, 1, smat, n, ipiv, v, n, info)
2948 cpassert(info == 0)
2949 ca(:) = v(:, 1)
2950
2951 DEALLOCATE (smat, tmat, v, ipiv)
2952
2953 END SUBROUTINE project_function_a
2954
2955! **************************************************************************************************
2956!> \brief ...
2957!> \param ca ...
2958!> \param a ...
2959!> \param bfun ...
2960!> \param grid_atom ...
2961!> \param l ...
2962! **************************************************************************************************
2963 SUBROUTINE project_function_b(ca, a, bfun, grid_atom, l)
2964 ! project function f on ca
2965 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: ca
2966 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: a, bfun
2967 TYPE(grid_atom_type), POINTER :: grid_atom
2968 INTEGER, INTENT(IN) :: l
2969
2970 INTEGER :: i, info, n, nr
2971 INTEGER, ALLOCATABLE, DIMENSION(:) :: ipiv
2972 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: afun
2973 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: smat, v
2974
2975 n = SIZE(ca)
2976 nr = grid_atom%nr
2977 ALLOCATE (smat(n, n), v(n, 1), ipiv(n), afun(nr))
2978
2979 CALL sg_overlap(smat, l, a, a)
2980 DO i = 1, n
2981 afun(:) = grid_atom%rad(:)**l*exp(-a(i)*grid_atom%rad2(:))
2982 v(i, 1) = sum(afun(:)*bfun(:)*grid_atom%wr(:))
2983 END DO
2984 CALL dgesv(n, 1, smat, n, ipiv, v, n, info)
2985 cpassert(info == 0)
2986 ca(:) = v(:, 1)
2987
2988 DEALLOCATE (smat, v, ipiv, afun)
2989
2990 END SUBROUTINE project_function_b
2991
2992! **************************************************************************************************
2993!> \brief Performs printing of cube files from local energy
2994!> \param input input
2995!> \param logger the logger
2996!> \param qs_env the qs_env in which the qs_env lives
2997!> \par History
2998!> 07.2019 created
2999!> \author JGH
3000! **************************************************************************************************
3001 SUBROUTINE qs_scf_post_local_energy(input, logger, qs_env)
3002 TYPE(section_vals_type), POINTER :: input
3003 TYPE(cp_logger_type), POINTER :: logger
3004 TYPE(qs_environment_type), POINTER :: qs_env
3005
3006 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_local_energy'
3007
3008 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube
3009 INTEGER :: handle, io_unit, natom, unit_nr
3010 LOGICAL :: append_cube, gapw, gapw_xc, mpi_io
3011 TYPE(dft_control_type), POINTER :: dft_control
3012 TYPE(particle_list_type), POINTER :: particles
3013 TYPE(pw_env_type), POINTER :: pw_env
3014 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
3015 TYPE(pw_r3d_rs_type) :: eden
3016 TYPE(qs_subsys_type), POINTER :: subsys
3017 TYPE(section_vals_type), POINTER :: dft_section
3018
3019 CALL timeset(routinen, handle)
3020 io_unit = cp_logger_get_default_io_unit(logger)
3021 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
3022 "DFT%PRINT%LOCAL_ENERGY_CUBE"), cp_p_file)) THEN
3023 dft_section => section_vals_get_subs_vals(input, "DFT")
3024 CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, natom=natom)
3025 gapw = dft_control%qs_control%gapw
3026 gapw_xc = dft_control%qs_control%gapw_xc
3027 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, subsys=subsys)
3028 CALL qs_subsys_get(subsys, particles=particles)
3029 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
3030 CALL auxbas_pw_pool%create_pw(eden)
3031 !
3032 CALL qs_local_energy(qs_env, eden)
3033 !
3034 append_cube = section_get_lval(input, "DFT%PRINT%LOCAL_ENERGY_CUBE%APPEND")
3035 IF (append_cube) THEN
3036 my_pos_cube = "APPEND"
3037 ELSE
3038 my_pos_cube = "REWIND"
3039 END IF
3040 mpi_io = .true.
3041 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%LOCAL_ENERGY_CUBE", &
3042 extension=".cube", middle_name="local_energy", &
3043 file_position=my_pos_cube, mpi_io=mpi_io)
3044 CALL cp_pw_to_cube(eden, &
3045 unit_nr, "LOCAL ENERGY", particles=particles, &
3046 stride=section_get_ivals(dft_section, &
3047 "PRINT%LOCAL_ENERGY_CUBE%STRIDE"), mpi_io=mpi_io)
3048 IF (io_unit > 0) THEN
3049 INQUIRE (unit=unit_nr, name=filename)
3050 IF (gapw .OR. gapw_xc) THEN
3051 WRITE (unit=io_unit, fmt="(/,T3,A,A)") &
3052 "The soft part of the local energy is written to the file: ", trim(adjustl(filename))
3053 ELSE
3054 WRITE (unit=io_unit, fmt="(/,T3,A,A)") &
3055 "The local energy is written to the file: ", trim(adjustl(filename))
3056 END IF
3057 END IF
3058 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3059 "DFT%PRINT%LOCAL_ENERGY_CUBE", mpi_io=mpi_io)
3060 !
3061 CALL auxbas_pw_pool%give_back_pw(eden)
3062 END IF
3063 CALL timestop(handle)
3064
3065 END SUBROUTINE qs_scf_post_local_energy
3066
3067! **************************************************************************************************
3068!> \brief Performs printing of cube files from local energy
3069!> \param input input
3070!> \param logger the logger
3071!> \param qs_env the qs_env in which the qs_env lives
3072!> \par History
3073!> 07.2019 created
3074!> \author JGH
3075! **************************************************************************************************
3076 SUBROUTINE qs_scf_post_local_stress(input, logger, qs_env)
3077 TYPE(section_vals_type), POINTER :: input
3078 TYPE(cp_logger_type), POINTER :: logger
3079 TYPE(qs_environment_type), POINTER :: qs_env
3080
3081 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_local_stress'
3082
3083 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube
3084 INTEGER :: handle, io_unit, natom, unit_nr
3085 LOGICAL :: append_cube, gapw, gapw_xc, mpi_io
3086 REAL(kind=dp) :: beta
3087 TYPE(dft_control_type), POINTER :: dft_control
3088 TYPE(particle_list_type), POINTER :: particles
3089 TYPE(pw_env_type), POINTER :: pw_env
3090 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
3091 TYPE(pw_r3d_rs_type) :: stress
3092 TYPE(qs_subsys_type), POINTER :: subsys
3093 TYPE(section_vals_type), POINTER :: dft_section
3094
3095 CALL timeset(routinen, handle)
3096 io_unit = cp_logger_get_default_io_unit(logger)
3097 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
3098 "DFT%PRINT%LOCAL_STRESS_CUBE"), cp_p_file)) THEN
3099 dft_section => section_vals_get_subs_vals(input, "DFT")
3100 CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, natom=natom)
3101 gapw = dft_control%qs_control%gapw
3102 gapw_xc = dft_control%qs_control%gapw_xc
3103 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, subsys=subsys)
3104 CALL qs_subsys_get(subsys, particles=particles)
3105 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
3106 CALL auxbas_pw_pool%create_pw(stress)
3107 !
3108 ! use beta=0: kinetic energy density in symmetric form
3109 beta = 0.0_dp
3110 CALL qs_local_stress(qs_env, beta=beta)
3111 !
3112 append_cube = section_get_lval(input, "DFT%PRINT%LOCAL_STRESS_CUBE%APPEND")
3113 IF (append_cube) THEN
3114 my_pos_cube = "APPEND"
3115 ELSE
3116 my_pos_cube = "REWIND"
3117 END IF
3118 mpi_io = .true.
3119 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%LOCAL_STRESS_CUBE", &
3120 extension=".cube", middle_name="local_stress", &
3121 file_position=my_pos_cube, mpi_io=mpi_io)
3122 CALL cp_pw_to_cube(stress, &
3123 unit_nr, "LOCAL STRESS", particles=particles, &
3124 stride=section_get_ivals(dft_section, &
3125 "PRINT%LOCAL_STRESS_CUBE%STRIDE"), mpi_io=mpi_io)
3126 IF (io_unit > 0) THEN
3127 INQUIRE (unit=unit_nr, name=filename)
3128 WRITE (unit=io_unit, fmt="(/,T3,A)") "Write 1/3*Tr(sigma) to cube file"
3129 IF (gapw .OR. gapw_xc) THEN
3130 WRITE (unit=io_unit, fmt="(T3,A,A)") &
3131 "The soft part of the local stress is written to the file: ", trim(adjustl(filename))
3132 ELSE
3133 WRITE (unit=io_unit, fmt="(T3,A,A)") &
3134 "The local stress is written to the file: ", trim(adjustl(filename))
3135 END IF
3136 END IF
3137 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3138 "DFT%PRINT%LOCAL_STRESS_CUBE", mpi_io=mpi_io)
3139 !
3140 CALL auxbas_pw_pool%give_back_pw(stress)
3141 END IF
3142
3143 CALL timestop(handle)
3144
3145 END SUBROUTINE qs_scf_post_local_stress
3146
3147! **************************************************************************************************
3148!> \brief Performs printing of cube files related to the implicit Poisson solver
3149!> \param input input
3150!> \param logger the logger
3151!> \param qs_env the qs_env in which the qs_env lives
3152!> \par History
3153!> 03.2016 refactored from write_mo_free_results [Hossein Bani-Hashemian]
3154!> \author Mohammad Hossein Bani-Hashemian
3155! **************************************************************************************************
3156 SUBROUTINE qs_scf_post_ps_implicit(input, logger, qs_env)
3157 TYPE(section_vals_type), POINTER :: input
3158 TYPE(cp_logger_type), POINTER :: logger
3159 TYPE(qs_environment_type), POINTER :: qs_env
3160
3161 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_ps_implicit'
3162
3163 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube
3164 INTEGER :: boundary_condition, handle, i, j, &
3165 n_cstr, n_tiles, unit_nr
3166 LOGICAL :: append_cube, do_cstr_charge_cube, do_dielectric_cube, do_dirichlet_bc_cube, &
3167 has_dirichlet_bc, has_implicit_ps, mpi_io, tile_cubes
3168 TYPE(particle_list_type), POINTER :: particles
3169 TYPE(pw_env_type), POINTER :: pw_env
3170 TYPE(pw_poisson_type), POINTER :: poisson_env
3171 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
3172 TYPE(pw_r3d_rs_type) :: aux_r
3173 TYPE(pw_r3d_rs_type), POINTER :: dirichlet_tile
3174 TYPE(qs_subsys_type), POINTER :: subsys
3175 TYPE(section_vals_type), POINTER :: dft_section
3176
3177 CALL timeset(routinen, handle)
3178
3179 NULLIFY (pw_env, auxbas_pw_pool, dft_section, particles)
3180
3181 dft_section => section_vals_get_subs_vals(input, "DFT")
3182 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, subsys=subsys)
3183 CALL qs_subsys_get(subsys, particles=particles)
3184 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
3185
3186 has_implicit_ps = .false.
3187 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
3188 IF (pw_env%poisson_env%parameters%solver .EQ. pw_poisson_implicit) has_implicit_ps = .true.
3189
3190 ! Write the dielectric constant into a cube file
3191 do_dielectric_cube = btest(cp_print_key_should_output(logger%iter_info, input, &
3192 "DFT%PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE"), cp_p_file)
3193 IF (has_implicit_ps .AND. do_dielectric_cube) THEN
3194 append_cube = section_get_lval(input, "DFT%PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE%APPEND")
3195 my_pos_cube = "REWIND"
3196 IF (append_cube) THEN
3197 my_pos_cube = "APPEND"
3198 END IF
3199 mpi_io = .true.
3200 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE", &
3201 extension=".cube", middle_name="DIELECTRIC_CONSTANT", file_position=my_pos_cube, &
3202 mpi_io=mpi_io)
3203 CALL pw_env_get(pw_env, poisson_env=poisson_env, auxbas_pw_pool=auxbas_pw_pool)
3204 CALL auxbas_pw_pool%create_pw(aux_r)
3205
3206 boundary_condition = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
3207 SELECT CASE (boundary_condition)
3209 CALL pw_copy(poisson_env%implicit_env%dielectric%eps, aux_r)
3210 CASE (mixed_bc, neumann_bc)
3211 CALL pw_shrink(pw_env%poisson_env%parameters%ps_implicit_params%neumann_directions, &
3212 pw_env%poisson_env%implicit_env%dct_env%dests_shrink, &
3213 pw_env%poisson_env%implicit_env%dct_env%srcs_shrink, &
3214 pw_env%poisson_env%implicit_env%dct_env%bounds_local_shftd, &
3215 poisson_env%implicit_env%dielectric%eps, aux_r)
3216 END SELECT
3217
3218 CALL cp_pw_to_cube(aux_r, unit_nr, "DIELECTRIC CONSTANT", particles=particles, &
3219 stride=section_get_ivals(dft_section, "PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE%STRIDE"), &
3220 mpi_io=mpi_io)
3221 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3222 "DFT%PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE", mpi_io=mpi_io)
3223
3224 CALL auxbas_pw_pool%give_back_pw(aux_r)
3225 END IF
3226
3227 ! Write Dirichlet constraint charges into a cube file
3228 do_cstr_charge_cube = btest(cp_print_key_should_output(logger%iter_info, input, &
3229 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE"), cp_p_file)
3230
3231 has_dirichlet_bc = .false.
3232 IF (has_implicit_ps) THEN
3233 boundary_condition = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
3234 IF (boundary_condition .EQ. mixed_periodic_bc .OR. boundary_condition .EQ. mixed_bc) THEN
3235 has_dirichlet_bc = .true.
3236 END IF
3237 END IF
3238
3239 IF (has_implicit_ps .AND. do_cstr_charge_cube .AND. has_dirichlet_bc) THEN
3240 append_cube = section_get_lval(input, &
3241 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE%APPEND")
3242 my_pos_cube = "REWIND"
3243 IF (append_cube) THEN
3244 my_pos_cube = "APPEND"
3245 END IF
3246 mpi_io = .true.
3247 unit_nr = cp_print_key_unit_nr(logger, input, &
3248 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE", &
3249 extension=".cube", middle_name="dirichlet_cstr_charge", file_position=my_pos_cube, &
3250 mpi_io=mpi_io)
3251 CALL pw_env_get(pw_env, poisson_env=poisson_env, auxbas_pw_pool=auxbas_pw_pool)
3252 CALL auxbas_pw_pool%create_pw(aux_r)
3253
3254 boundary_condition = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
3255 SELECT CASE (boundary_condition)
3256 CASE (mixed_periodic_bc)
3257 CALL pw_copy(poisson_env%implicit_env%cstr_charge, aux_r)
3258 CASE (mixed_bc)
3259 CALL pw_shrink(pw_env%poisson_env%parameters%ps_implicit_params%neumann_directions, &
3260 pw_env%poisson_env%implicit_env%dct_env%dests_shrink, &
3261 pw_env%poisson_env%implicit_env%dct_env%srcs_shrink, &
3262 pw_env%poisson_env%implicit_env%dct_env%bounds_local_shftd, &
3263 poisson_env%implicit_env%cstr_charge, aux_r)
3264 END SELECT
3265
3266 CALL cp_pw_to_cube(aux_r, unit_nr, "DIRICHLET CONSTRAINT CHARGE", particles=particles, &
3267 stride=section_get_ivals(dft_section, "PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE%STRIDE"), &
3268 mpi_io=mpi_io)
3269 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3270 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE", mpi_io=mpi_io)
3271
3272 CALL auxbas_pw_pool%give_back_pw(aux_r)
3273 END IF
3274
3275 ! Write Dirichlet type constranits into cube files
3276 do_dirichlet_bc_cube = btest(cp_print_key_should_output(logger%iter_info, input, &
3277 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE"), cp_p_file)
3278 has_dirichlet_bc = .false.
3279 IF (has_implicit_ps) THEN
3280 boundary_condition = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
3281 IF (boundary_condition .EQ. mixed_periodic_bc .OR. boundary_condition .EQ. mixed_bc) THEN
3282 has_dirichlet_bc = .true.
3283 END IF
3284 END IF
3285
3286 IF (has_implicit_ps .AND. has_dirichlet_bc .AND. do_dirichlet_bc_cube) THEN
3287 append_cube = section_get_lval(input, "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%APPEND")
3288 my_pos_cube = "REWIND"
3289 IF (append_cube) THEN
3290 my_pos_cube = "APPEND"
3291 END IF
3292 tile_cubes = section_get_lval(input, "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%TILE_CUBES")
3293
3294 CALL pw_env_get(pw_env, poisson_env=poisson_env, auxbas_pw_pool=auxbas_pw_pool)
3295 CALL auxbas_pw_pool%create_pw(aux_r)
3296 CALL pw_zero(aux_r)
3297
3298 IF (tile_cubes) THEN
3299 ! one cube file per tile
3300 n_cstr = SIZE(poisson_env%implicit_env%contacts)
3301 DO j = 1, n_cstr
3302 n_tiles = poisson_env%implicit_env%contacts(j)%dirichlet_bc%n_tiles
3303 DO i = 1, n_tiles
3304 filename = "dirichlet_cstr_"//trim(adjustl(cp_to_string(j)))// &
3305 "_tile_"//trim(adjustl(cp_to_string(i)))
3306 mpi_io = .true.
3307 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE", &
3308 extension=".cube", middle_name=filename, file_position=my_pos_cube, &
3309 mpi_io=mpi_io)
3310
3311 CALL pw_copy(poisson_env%implicit_env%contacts(j)%dirichlet_bc%tiles(i)%tile%tile_pw, aux_r)
3312
3313 CALL cp_pw_to_cube(aux_r, unit_nr, "DIRICHLET TYPE CONSTRAINT", particles=particles, &
3314 stride=section_get_ivals(dft_section, "PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%STRIDE"), &
3315 mpi_io=mpi_io)
3316 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3317 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE", mpi_io=mpi_io)
3318 END DO
3319 END DO
3320 ELSE
3321 ! a single cube file
3322 NULLIFY (dirichlet_tile)
3323 ALLOCATE (dirichlet_tile)
3324 CALL auxbas_pw_pool%create_pw(dirichlet_tile)
3325 CALL pw_zero(dirichlet_tile)
3326 mpi_io = .true.
3327 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE", &
3328 extension=".cube", middle_name="DIRICHLET_CSTR", file_position=my_pos_cube, &
3329 mpi_io=mpi_io)
3330
3331 n_cstr = SIZE(poisson_env%implicit_env%contacts)
3332 DO j = 1, n_cstr
3333 n_tiles = poisson_env%implicit_env%contacts(j)%dirichlet_bc%n_tiles
3334 DO i = 1, n_tiles
3335 CALL pw_copy(poisson_env%implicit_env%contacts(j)%dirichlet_bc%tiles(i)%tile%tile_pw, dirichlet_tile)
3336 CALL pw_axpy(dirichlet_tile, aux_r)
3337 END DO
3338 END DO
3339
3340 CALL cp_pw_to_cube(aux_r, unit_nr, "DIRICHLET TYPE CONSTRAINT", particles=particles, &
3341 stride=section_get_ivals(dft_section, "PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%STRIDE"), &
3342 mpi_io=mpi_io)
3343 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3344 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE", mpi_io=mpi_io)
3345 CALL auxbas_pw_pool%give_back_pw(dirichlet_tile)
3346 DEALLOCATE (dirichlet_tile)
3347 END IF
3348
3349 CALL auxbas_pw_pool%give_back_pw(aux_r)
3350 END IF
3351
3352 CALL timestop(handle)
3353
3354 END SUBROUTINE qs_scf_post_ps_implicit
3355
3356!**************************************************************************************************
3357!> \brief write an adjacency (interaction) matrix
3358!> \param qs_env qs environment
3359!> \param input the input
3360!> \author Mohammad Hossein Bani-Hashemian
3361! **************************************************************************************************
3362 SUBROUTINE write_adjacency_matrix(qs_env, input)
3363 TYPE(qs_environment_type), POINTER :: qs_env
3364 TYPE(section_vals_type), POINTER :: input
3365
3366 CHARACTER(len=*), PARAMETER :: routinen = 'write_adjacency_matrix'
3367
3368 INTEGER :: adjm_size, colind, handle, iatom, ikind, &
3369 ind, jatom, jkind, k, natom, nkind, &
3370 output_unit, rowind, unit_nr
3371 INTEGER, ALLOCATABLE, DIMENSION(:) :: interact_adjm
3372 LOGICAL :: do_adjm_write, do_symmetric
3373 TYPE(cp_logger_type), POINTER :: logger
3374 TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: basis_set_list_a, basis_set_list_b
3375 TYPE(gto_basis_set_type), POINTER :: basis_set_a, basis_set_b
3376 TYPE(mp_para_env_type), POINTER :: para_env
3378 DIMENSION(:), POINTER :: nl_iterator
3379 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
3380 POINTER :: nl
3381 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
3382 TYPE(section_vals_type), POINTER :: dft_section
3383
3384 CALL timeset(routinen, handle)
3385
3386 NULLIFY (dft_section)
3387
3388 logger => cp_get_default_logger()
3389 output_unit = cp_logger_get_default_io_unit(logger)
3390
3391 dft_section => section_vals_get_subs_vals(input, "DFT")
3392 do_adjm_write = btest(cp_print_key_should_output(logger%iter_info, dft_section, &
3393 "PRINT%ADJMAT_WRITE"), cp_p_file)
3394
3395 IF (do_adjm_write) THEN
3396 NULLIFY (qs_kind_set, nl_iterator)
3397 NULLIFY (basis_set_list_a, basis_set_list_b, basis_set_a, basis_set_b)
3398
3399 CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, sab_orb=nl, natom=natom, para_env=para_env)
3400
3401 nkind = SIZE(qs_kind_set)
3402 cpassert(SIZE(nl) .GT. 0)
3403 CALL get_neighbor_list_set_p(neighbor_list_sets=nl, symmetric=do_symmetric)
3404 cpassert(do_symmetric)
3405 ALLOCATE (basis_set_list_a(nkind), basis_set_list_b(nkind))
3406 CALL basis_set_list_setup(basis_set_list_a, "ORB", qs_kind_set)
3407 CALL basis_set_list_setup(basis_set_list_b, "ORB", qs_kind_set)
3408
3409 adjm_size = ((natom + 1)*natom)/2
3410 ALLOCATE (interact_adjm(4*adjm_size))
3411 interact_adjm = 0
3412
3413 NULLIFY (nl_iterator)
3414 CALL neighbor_list_iterator_create(nl_iterator, nl)
3415 DO WHILE (neighbor_list_iterate(nl_iterator) .EQ. 0)
3416 CALL get_iterator_info(nl_iterator, &
3417 ikind=ikind, jkind=jkind, &
3418 iatom=iatom, jatom=jatom)
3419
3420 basis_set_a => basis_set_list_a(ikind)%gto_basis_set
3421 IF (.NOT. ASSOCIATED(basis_set_a)) cycle
3422 basis_set_b => basis_set_list_b(jkind)%gto_basis_set
3423 IF (.NOT. ASSOCIATED(basis_set_b)) cycle
3424
3425 ! move everything to the upper triangular part
3426 IF (iatom .LE. jatom) THEN
3427 rowind = iatom
3428 colind = jatom
3429 ELSE
3430 rowind = jatom
3431 colind = iatom
3432 ! swap the kinds too
3433 ikind = ikind + jkind
3434 jkind = ikind - jkind
3435 ikind = ikind - jkind
3436 END IF
3437
3438 ! indexing upper triangular matrix
3439 ind = adjm_size - (natom - rowind + 1)*((natom - rowind + 1) + 1)/2 + colind - rowind + 1
3440 ! convert the upper triangular matrix into a adjm_size x 4 matrix
3441 ! columns are: iatom, jatom, ikind, jkind
3442 interact_adjm((ind - 1)*4 + 1) = rowind
3443 interact_adjm((ind - 1)*4 + 2) = colind
3444 interact_adjm((ind - 1)*4 + 3) = ikind
3445 interact_adjm((ind - 1)*4 + 4) = jkind
3446 END DO
3447
3448 CALL para_env%sum(interact_adjm)
3449
3450 unit_nr = cp_print_key_unit_nr(logger, dft_section, "PRINT%ADJMAT_WRITE", &
3451 extension=".adjmat", file_form="FORMATTED", &
3452 file_status="REPLACE")
3453 IF (unit_nr .GT. 0) THEN
3454 WRITE (unit_nr, "(1A,2X,1A,5X,1A,4X,A5,3X,A5)") "#", "iatom", "jatom", "ikind", "jkind"
3455 DO k = 1, 4*adjm_size, 4
3456 ! print only the interacting atoms
3457 IF (interact_adjm(k) .GT. 0 .AND. interact_adjm(k + 1) .GT. 0) THEN
3458 WRITE (unit_nr, "(I8,2X,I8,3X,I6,2X,I6)") interact_adjm(k:k + 3)
3459 END IF
3460 END DO
3461 END IF
3462
3463 CALL cp_print_key_finished_output(unit_nr, logger, dft_section, "PRINT%ADJMAT_WRITE")
3464
3465 CALL neighbor_list_iterator_release(nl_iterator)
3466 DEALLOCATE (basis_set_list_a, basis_set_list_b)
3467 END IF
3468
3469 CALL timestop(handle)
3470
3471 END SUBROUTINE write_adjacency_matrix
3472
3473! **************************************************************************************************
3474!> \brief Updates Hartree potential with MP2 density. Important for REPEAT charges
3475!> \param rho ...
3476!> \param qs_env ...
3477!> \author Vladimir Rybkin
3478! **************************************************************************************************
3479 SUBROUTINE update_hartree_with_mp2(rho, qs_env)
3480 TYPE(qs_rho_type), POINTER :: rho
3481 TYPE(qs_environment_type), POINTER :: qs_env
3482
3483 LOGICAL :: use_virial
3484 TYPE(pw_c1d_gs_type) :: rho_tot_gspace, v_hartree_gspace
3485 TYPE(pw_c1d_gs_type), POINTER :: rho_core
3486 TYPE(pw_env_type), POINTER :: pw_env
3487 TYPE(pw_poisson_type), POINTER :: poisson_env
3488 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
3489 TYPE(pw_r3d_rs_type), POINTER :: v_hartree_rspace
3490 TYPE(qs_energy_type), POINTER :: energy
3491 TYPE(virial_type), POINTER :: virial
3492
3493 NULLIFY (auxbas_pw_pool, pw_env, poisson_env, energy, rho_core, v_hartree_rspace, virial)
3494 CALL get_qs_env(qs_env, pw_env=pw_env, energy=energy, &
3495 rho_core=rho_core, virial=virial, &
3496 v_hartree_rspace=v_hartree_rspace)
3497
3498 use_virial = virial%pv_availability .AND. (.NOT. virial%pv_numer)
3499
3500 IF (.NOT. use_virial) THEN
3501
3502 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
3503 poisson_env=poisson_env)
3504 CALL auxbas_pw_pool%create_pw(v_hartree_gspace)
3505 CALL auxbas_pw_pool%create_pw(rho_tot_gspace)
3506
3507 CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho)
3508 CALL pw_poisson_solve(poisson_env, rho_tot_gspace, energy%hartree, &
3509 v_hartree_gspace, rho_core=rho_core)
3510
3511 CALL pw_transfer(v_hartree_gspace, v_hartree_rspace)
3512 CALL pw_scale(v_hartree_rspace, v_hartree_rspace%pw_grid%dvol)
3513
3514 CALL auxbas_pw_pool%give_back_pw(v_hartree_gspace)
3515 CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace)
3516 END IF
3517
3518 END SUBROUTINE update_hartree_with_mp2
3519
3520END MODULE qs_scf_post_gpw
static double norm_factor(double alpha, int L)
Types and set/get functions for auxiliary density matrix methods.
Definition admm_types.F:15
Contains methods used in the context of density fitting.
Definition admm_utils.F:15
subroutine, public admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_matrix)
...
Definition admm_utils.F:127
subroutine, public admm_correct_for_eigenvalues(ispin, admm_env, ks_matrix)
...
Definition admm_utils.F:53
subroutine, public sg_overlap(smat, l, pa, pb)
...
calculate the orbitals for a given atomic kind type
subroutine, public calculate_atomic_density(density, atomic_kind, qs_kind, ngto, iunit, optbasis, allelectron, confine)
...
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
Handles all functions related to the CELL.
Definition cell_types.F:15
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
methods related to the blacs parallel environment
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
DBCSR operations in CP2K.
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
DBCSR output in CP2K.
subroutine, public cp_dbcsr_write_sparse_matrix(sparse_matrix, before, after, qs_env, para_env, first_row, last_row, first_col, last_col, scale, output_unit, omit_headers)
...
Density Derived atomic point charges from a QM calculation (see Bloechl, J. Chem. Phys....
recursive subroutine, public get_ddapc(qs_env, calc_force, density_fit_section, density_type, qout1, qout2, out_radii, dq_out, ext_rho_tot_g, itype_of_density, iwc)
Computes the Density Derived Atomic Point Charges.
used for collecting some of the diagonalization schemes available for cp_fm_type. cp_fm_power also mo...
Definition cp_fm_diag.F:17
subroutine, public choose_eigv_solver(matrix, eigenvectors, eigenvalues, info)
Choose the Eigensolver depending on which library is available ELPA seems to be unstable for small sy...
Definition cp_fm_diag.F:236
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_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_init_random(matrix, ncol, start_col)
fills a matrix with random numbers
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
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 ...
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...
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
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, stride, zero_tails, silent, mpi_io)
...
the type I Discrete Cosine Transform (DCT-I)
Definition dct.F:16
subroutine, public pw_shrink(neumann_directions, dests_shrink, srcs_shrink, bounds_local_shftd, pw_in, pw_shrinked)
shrinks an evenly symmetric pw_r3d_rs_type data to a pw_r3d_rs_type data that is 8 times smaller (the...
Definition dct.F:700
Calculate Energy Decomposition analysis.
Definition ed_analysis.F:14
subroutine, public edmf_analysis(qs_env, input_section, unit_nr)
...
Calculation of charge equilibration method.
Definition eeq_method.F:12
subroutine, public eeq_print(qs_env, iounit, print_level, ext)
...
Definition eeq_method.F:124
Definition and initialisation of the et_coupling data type.
subroutine, public set_et_coupling_type(et_coupling, et_mo_coeff, rest_mat)
...
RI-methods for HFX.
Definition hfx_ri.F:12
subroutine, public print_ri_hfx(ri_data, qs_env)
Print RI-HFX quantities, as required by the PRINT subsection.
Definition hfx_ri.F:3627
Calculate Hirshfeld charges and related functions.
subroutine, public comp_hirshfeld_charges(qs_env, hirshfeld_env, charges)
...
subroutine, public create_shape_function(hirshfeld_env, qs_kind_set, atomic_kind_set, radius, radii_list)
creates kind specific shape functions for Hirshfeld charges
subroutine, public write_hirshfeld_charges(charges, hirshfeld_env, particle_set, qs_kind_set, unit_nr)
...
subroutine, public comp_hirshfeld_i_charges(qs_env, hirshfeld_env, charges, ounit)
...
subroutine, public save_hirshfeld_charges(charges, particle_set, qs_kind_set, qs_env)
saves the Hirshfeld charges to the results structure
The types needed for the calculation of Hirshfeld charges and related functions.
subroutine, public create_hirshfeld_type(hirshfeld_env)
...
subroutine, public set_hirshfeld_info(hirshfeld_env, shape_function_type, iterative, ref_charge, fnorm, radius_type, use_bohr)
Set values of a Hirshfeld env.
subroutine, public release_hirshfeld_type(hirshfeld_env)
...
Calculate intrinsic atomic orbitals and analyze wavefunctions.
subroutine, public iao_wfn_analysis(qs_env, iao_env, unit_nr, c_iao_coef, mos, bond_centers)
...
Calculate ntrinsic atomic orbitals and analyze wavefunctions.
Definition iao_types.F:14
subroutine, public iao_read_input(iao_env, iao_section, cell)
...
Definition iao_types.F:116
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public do_loc_jacobi
integer, parameter, public ref_charge_atomic
integer, parameter, public do_loc_mixed
integer, parameter, public do_loc_none
integer, parameter, public do_loc_lumo
integer, parameter, public radius_user
integer, parameter, public radius_covalent
integer, parameter, public ref_charge_mulliken
integer, parameter, public do_loc_homo
integer, parameter, public do_mixed
integer, parameter, public do_loc_both
integer, parameter, public ot_precond_full_all
objects that represent the structure of input sections and the data contained in an input section
real(kind=dp) function, public section_get_rval(section_vals, keyword_name)
...
integer function, dimension(:), pointer, public section_get_ivals(section_vals, keyword_name)
...
integer function, public section_get_ival(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
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
logical function, public section_get_lval(section_vals, keyword_name)
...
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
integer, parameter, public default_path_length
Definition kinds.F:58
Types and basic routines needed for a kpoint calculation.
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition list.F:24
Calculate MAO's and analyze wavefunctions.
subroutine, public mao_analysis(qs_env, input_section, unit_nr)
...
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
Utility routines for the memory handling.
Interface to the message passing library MPI.
Calculate localized minimal basis and analyze wavefunctions.
subroutine, public minbas_analysis(qs_env, input_section, unit_nr)
...
Functions handling the MOLDEN format. Split from mode_selective.
subroutine, public write_mos_molden(mos, qs_kind_set, particle_set, print_section)
Write out the MOs in molden format for visualisation.
Define the data structure for the molecule information.
compute mulliken charges we (currently) define them as c_i = 1/2 [ (PS)_{ii} + (SP)_{ii} ]
Definition mulliken.F:13
Provides Cartesian and spherical orbital pointers and indices.
integer, dimension(:, :), allocatable, public indso
represent a simple array based list of the given type
Define the data structure for the particle information.
Definition of physical constants:
Definition physcon.F:68
real(kind=dp), parameter, public evolt
Definition physcon.F:183
real(kind=dp), parameter, public angstrom
Definition physcon.F:144
Provide various population analyses and print the requested output information.
subroutine, public lowdin_population_analysis(qs_env, output_unit, print_level)
Perform a Lowdin population analysis based on a symmetric orthogonalisation of the density matrix usi...
subroutine, public mulliken_population_analysis(qs_env, output_unit, print_level)
Perform a Mulliken population analysis.
types of preconditioners
computes preconditioners, and implements methods to apply them currently used in qs_ot
Types containing essential information for running implicit (iterative) Poisson solver.
integer, parameter, public neumann_bc
integer, parameter, public mixed_bc
integer, parameter, public mixed_periodic_bc
integer, parameter, public periodic_bc
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
This module defines the grid data type and some basic operations on it.
Definition pw_grids.F:36
subroutine, public get_pw_grid_info(pw_grid, id_nr, mode, vol, dvol, npts, ngpts, ngpts_cut, dr, cutoff, orthorhombic, gvectors, gsquare)
Access to information stored in the pw_grid_type.
Definition pw_grids.F:185
subroutine, public pw_derive(pw, n)
Calculate the derivative of a plane wave vector.
functions related to the poisson solver on regular grids
integer, parameter, public pw_poisson_implicit
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Write wfx file, works as interface to chargemol and multiwfn.
subroutine, public write_wfx(qs_env, dft_section)
...
Calculate the plane wave density by collocating the primitive Gaussian functions (pgf).
subroutine, public calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, pw_env, basis_type)
maps a given wavefunction on the grid
Calculation of commutator [H,r] matrices.
subroutine, public build_com_hr_matrix(qs_env, matrix_hr)
Calculation of the [H,r] commutators matrices over Cartesian Gaussian functions.
Calculation of the energies concerning the core charge distribution.
Calculation and writing of density of states.
Definition qs_dos.F:14
subroutine, public calculate_dos(mos, dft_section)
Compute and write density of states.
Definition qs_dos.F:59
subroutine, public calculate_dos_kp(qs_env, dft_section)
Compute and write density of states (kpoints)
Definition qs_dos.F:206
Calculates electric field gradients H.M. Petrili, P.E. Blochl, P. Blaha, K. Schwarz,...
subroutine, public qs_efg_calc(qs_env)
...
Does all kind of post scf calculations for GPW/GAPW.
subroutine, public qs_elf_calc(qs_env, elf_r, rho_cutoff)
...
Does all kind of post scf calculations for GPW/GAPW.
subroutine, public energy_windows(qs_env)
...
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
subroutine, public set_qs_env(qs_env, super_cell, mos, qmmm, qmmm_periodic, ewald_env, ewald_pw, mpools, rho_external, external_vxc, mask, scf_control, rel_control, qs_charges, ks_env, ks_qmmm_env, wf_history, scf_env, active_space, input, oce, rho_atom_set, rho0_atom_set, rho0_mpole, run_rtp, rtp, rhoz_set, rhoz_tot, ecoul_1c, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, efield, rhoz_cneo_set, linres_control, xas_env, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, ls_scf_env, do_transport, transport_env, lri_env, lri_density, exstate_env, ec_env, dispersion_env, harris_env, gcp_env, mp2_env, bs_env, kg_env, force, kpoints, wanniercentres, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Set the QUICKSTEP environment.
Calculates hyperfine values.
Definition qs_epr_hyp.F:15
subroutine, public qs_epr_hyp_calc(qs_env)
...
Definition qs_epr_hyp.F:75
Some utility functions for the calculation of integrals.
subroutine, public basis_set_list_setup(basis_set_list, basis_type, qs_kind_set)
Set up an easy accessible list of the basis sets for all kinds.
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, cneo_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
routines that build the Kohn-Sham matrix (i.e calculate the coulomb and xc parts
subroutine, public qs_ks_update_qs_env(qs_env, calculate_forces, just_energy, print_active)
updates the Kohn Sham matrix of the given qs_env (facility method)
subroutine, public calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho, skip_nuclear_density)
...
subroutine, public qs_ks_did_change(ks_env, s_mstruct_changed, rho_changed, potential_changed, full_reset)
tells that some of the things relevant to the ks calculation did change. has to be called when change...
subroutine, public loc_dipole(input, dft_control, qs_loc_env, logger, qs_env)
Computes and prints the Dipole (using localized charges)
subroutine, public get_localization_info(qs_env, qs_loc_env, loc_section, mo_local, wf_r, wf_g, particles, coeff, evals, marked_states)
Performs localization of the orbitals.
New version of the module for the localization of the molecular orbitals This should be able to use d...
subroutine, public qs_loc_env_release(qs_loc_env)
...
subroutine, public qs_loc_env_create(qs_loc_env)
...
Some utilities for the construction of the localization environment.
subroutine, public loc_write_restart(qs_loc_env, section, mo_array, coeff_localized, do_homo, evals, do_mixed)
...
subroutine, public qs_loc_env_init(qs_loc_env, localized_wfn_control, qs_env, myspin, do_localize, loc_coeff, mo_loc_history)
allocates the data, and initializes the operators
subroutine, public qs_loc_control_init(qs_loc_env, loc_section, do_homo, do_mixed, do_xas, nloc_xas, spin_xas)
initializes everything needed for localization of the HOMOs
subroutine, public retain_history(mo_loc_history, mo_loc)
copy old mos to new ones, allocating as necessary
subroutine, public qs_loc_init(qs_env, qs_loc_env, localize_section, mos_localized, do_homo, do_mo_cubes, mo_loc_history, evals, tot_zeff_corr, do_mixed)
initializes everything needed for localization of the molecular orbitals
Routines for calculating local energy and stress tensor.
subroutine, public qs_local_stress(qs_env, stress_tensor, beta)
Routine to calculate the local stress.
subroutine, public qs_local_energy(qs_env, energy_density)
Routine to calculate the local energy.
Definition and initialisation of the mo data type.
Definition qs_mo_io.F:21
subroutine, public write_dm_binary_restart(mo_array, dft_section, tmpl_matrix)
calculates density matrix from mo set and writes the density matrix into a binary restart file
Definition qs_mo_io.F:174
collects routines that perform operations directly related to MOs
subroutine, public make_mo_eig(mos, nspins, ks_rmpv, scf_control, mo_derivs, admm_env, hairy_probes, probe)
Calculate KS eigenvalues starting from OF MOS.
Set occupation of molecular orbitals.
Definition and initialisation of the mo data type.
Definition qs_mo_types.F:22
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
Calculates the moment integrals <a|r^m|b> and <a|r x d/dr|b>
Definition qs_moments.F:14
subroutine, public qs_moment_locop(qs_env, magnetic, nmoments, reference, ref_point, unit_number, vel_reprs, com_nl)
...
subroutine, public qs_moment_berry_phase(qs_env, magnetic, nmoments, reference, ref_point, unit_number)
...
Define the neighbor list data types and the corresponding functionality.
subroutine, public neighbor_list_iterator_create(iterator_set, nl, search, nthread)
Neighbor list iterator functions.
subroutine, public neighbor_list_iterator_release(iterator_set)
...
subroutine, public get_neighbor_list_set_p(neighbor_list_sets, nlist, symmetric)
Return the components of the first neighbor list set.
integer function, public neighbor_list_iterate(iterator_set, mepos)
...
subroutine, public get_iterator_info(iterator_set, mepos, ikind, jkind, nkind, ilist, nlist, inode, nnode, iatom, jatom, r, cell)
...
an eigen-space solver for the generalised symmetric eigenvalue problem for sparse matrices,...
subroutine, public ot_eigensolver(matrix_h, matrix_s, matrix_orthogonal_space_fm, matrix_c_fm, preconditioner, eps_gradient, iter_max, size_ortho_space, silent, ot_settings)
...
Calculation and writing of projected density of states The DOS is computed per angular momentum and p...
Definition qs_pdos.F:15
subroutine, public calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particle_set, qs_env, dft_section, ispin, xas_mittle, external_matrix_shalf)
Compute and write projected density of states.
Definition qs_pdos.F:139
provides a resp fit for gas phase systems
Definition qs_resp.F:16
subroutine, public resp_fit(qs_env)
performs resp fit and generates RESP charges
Definition qs_resp.F:132
subroutine, public get_rho0_mpole(rho0_mpole, g0_h, vg0_h, iat, ikind, lmax_0, l0_ikind, mp_gau_ikind, mp_rho, norm_g0l_h, qlm_gg, qlm_car, qlm_tot, zet0_h, igrid_zet0_s, rpgf0_h, rpgf0_s, max_rpgf0_s, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs)
...
methods of the rho structure (defined in qs_rho_types)
subroutine, public qs_rho_update_rho(rho_struct, qs_env, rho_xc_external, local_rho_set, task_list_external, task_list_external_soft, pw_env_external, para_env_external)
updates rho_r and rho_g to the rhorho_ao. if use_kinetic_energy_density also computes tau_r and tau_g...
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...
Functions to print the KS and S matrix in the CSR format to file.
subroutine, public write_s_matrix_csr(qs_env, input)
writing the overlap matrix in csr format into a file
subroutine, public write_ks_matrix_csr(qs_env, input)
writing the KS matrix in csr format into a file
subroutine, public qs_scf_write_mos(qs_env, scf_env, final_mos)
Write the MO eigenvector, eigenvalues, and occupation numbers to the output unit.
Does all kind of post scf calculations for GPW/GAPW.
subroutine, public make_lumo_gpw(qs_env, scf_env, unoccupied_orbs, unoccupied_evals, nlumo, nlumos)
Gets the lumos, and eigenvalues for the lumos.
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...
subroutine, public scf_post_calculation_gpw(qs_env, wf_type, do_mp2)
collects possible post - scf calculations and prints info / computes properties.
module that contains the definitions of the scf types
integer, parameter, public ot_method_nr
Does all kind of post scf calculations for GPW/GAPW.
subroutine, public wfn_mix(mos, particle_set, dft_section, qs_kind_set, para_env, output_unit, unoccupied_orbs, scf_env, matrix_s, marked_states, for_rtp)
writes a new 'mixed' set of mos to restart file, without touching the current MOs
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)
...
Interface to Wannier90 code.
subroutine, public wannier90_interface(input, logger, qs_env)
...
Methods related to (\cal S)^2 (i.e. spin)
subroutine, public compute_s_square(mos, matrix_s, s_square, s_square_ideal, mo_derivs, strength)
Compute the expectation value <(\cal S)^2> of the single determinant defined by the spin up (alpha) a...
parameters that control an scf iteration
Calculation of STM image as post processing of an electronic structure calculation,...
Definition stm_images.F:15
subroutine, public th_stm_image(qs_env, stm_section, particles, unoccupied_orbs, unoccupied_evals)
Driver for the calculation of STM image, as post processing of a ground-state electronic structure ca...
Definition stm_images.F:90
routines for DFT+NEGF calculations (coupling with the quantum transport code OMEN)
Definition transport.F:19
subroutine, public qs_scf_post_transport(qs_env)
post scf calculations for transport
Definition transport.F:747
The module to read/write TREX IO files for interfacing CP2K with other programs.
subroutine, public write_trexio(qs_env, trexio_section, energy_derivative)
Write a trexio file.
Interface for Voronoi Integration and output of BQB files.
subroutine, public entry_voronoi_or_bqb(do_voro, do_bqb, input_voro, input_bqb, unit_voro, qs_env, rspace_pw)
Does a Voronoi integration of density or stores the density to compressed BQB format.
subroutine, public xray_diffraction_spectrum(qs_env, unit_number, q_max)
Calculate the coherent X-ray diffraction spectrum using the total electronic density in reciprocal sp...
subroutine, public calculate_rhotot_elec_gspace(qs_env, auxbas_pw_pool, rhotot_elec_gspace, q_max, rho_hard, rho_soft, fsign)
The total electronic density in reciprocal space (g-space) is calculated.
stores some data used in wavefunction fitting
Definition admm_types.F:120
Provides all information about an atomic kind.
Type defining parameters related to the simulation cell.
Definition cell_types.F:55
represent a pointer to a 1d array
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
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...
quantities needed for a Hirshfeld based partitioning of real space
Contains information about kpoints.
stores all the informations relevant to an mpi environment
contained for different pw related things
environment for the poisson solver
to create arrays of pools
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.
contains all the info needed by quickstep to calculate the spread of a selected set of orbitals and i...
keeps the density in various representations, keeping track of which ones are valid.