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