(git:08825b9)
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-2026 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 casino_utils, ONLY: write_casino
26 USE cell_types, ONLY: cell_type
32 USE cp_dbcsr_api, ONLY: dbcsr_add,&
36 dbcsr_set,&
38 dbcsr_type_antisymmetric
45 USE cp_ddapc_util, ONLY: get_ddapc
50 USE cp_fm_types, ONLY: cp_fm_create,&
61 cp_p_file,&
72 USE dct, ONLY: pw_shrink
73 USE ed_analysis, ONLY: edmf_analysis
74 USE eeq_method, ONLY: eeq_print
77 USE hfx_ri, ONLY: print_ri_hfx
88 USE iao_types, ONLY: iao_env_type,&
90 USE input_constants, ONLY: &
102 USE kinds, ONLY: default_path_length,&
104 dp
106 USE kpoint_types, ONLY: kpoint_type
109 USE mathconstants, ONLY: pi
115 USE mulliken, ONLY: mulliken_charges
116 USE orbital_pointers, ONLY: indso
119 USE physcon, ONLY: a_bohr,&
120 angstrom,&
121 debye,&
122 evolt
126 USE ps_implicit_types, ONLY: mixed_bc,&
128 neumann_bc,&
130 USE pw_env_types, ONLY: pw_env_get,&
132 USE pw_grids, ONLY: get_pw_grid_info
133 USE pw_methods, ONLY: pw_axpy,&
134 pw_copy,&
135 pw_derive,&
137 pw_scale,&
139 pw_zero
143 USE pw_pool_types, ONLY: pw_pool_p_type,&
145 USE pw_types, ONLY: pw_c1d_gs_type,&
147 USE qs_chargemol, ONLY: write_wfx
152 USE qs_dos, ONLY: calculate_dos,&
156 USE qs_elf_methods, ONLY: qs_elf_calc
162 USE qs_epr_hyp, ONLY: qs_epr_hyp_calc
163 USE qs_fod, ONLY: qs_scf_post_fod
166 USE qs_kind_types, ONLY: get_qs_kind,&
172 USE qs_loc_dipole, ONLY: loc_dipole
188 USE qs_mo_types, ONLY: get_mo_set,&
205 USE qs_resp, ONLY: resp_fit
206 USE qs_rho0_types, ONLY: get_rho0_mpole,&
211 USE qs_rho_types, ONLY: qs_rho_get,&
218 USE qs_scf_types, ONLY: ot_method_nr,&
220 USE qs_scf_wfn_mix, ONLY: wfn_mix
222 USE qs_subsys_types, ONLY: qs_subsys_get,&
227 USE stm_images, ONLY: th_stm_image
229 USE trexio_utils, ONLY: write_trexio
230 USE virial_types, ONLY: virial_type
233#include "./base/base_uses.f90"
234
235 IMPLICIT NONE
236 PRIVATE
237
238 ! Global parameters
239 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_scf_post_gpw'
240 PUBLIC :: make_lumo_gpw, &
245
246 CHARACTER(len=*), PARAMETER :: &
247 str_mo_cubes = "PRINT%MO_CUBES", &
248 str_mo_openpmd = "PRINT%MO_OPENPMD", &
249 str_elf_cubes = "PRINT%ELF_CUBE", &
250 str_elf_openpmd = "PRINT%ELF_OPENPMD", &
251 str_e_density_cubes = "PRINT%E_DENSITY_CUBE", &
252 str_e_density_openpmd = "PRINT%E_DENSITY_OPENPMD"
253
254 INTEGER, PARAMETER :: grid_output_cubes = 1, grid_output_openpmd = 2
255
256 REAL(kind=dp), DIMENSION(7), PARAMETER :: openpmd_unit_dimension_density = &
257 [-3, 0, 0, 0, 0, 0, 0]
258 REAL(kind=dp), DIMENSION(7), PARAMETER :: openpmd_unit_dimension_dimensionless = &
259 [0, 0, 0, 0, 0, 0, 0]
260 REAL(kind=dp), DIMENSION(7), PARAMETER :: openpmd_unit_dimension_wavefunction = &
261 [-1.5_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp, 0.0_dp]
262 REAL(kind=dp), PARAMETER :: openpmd_unit_si_density = a_bohr**(-3)
263 REAL(kind=dp), PARAMETER :: openpmd_unit_si_dimensionless = 1.0_dp
264 REAL(kind=dp), PARAMETER :: openpmd_unit_si_wavefunction = a_bohr**(-1.5_dp)
265
266 ! Generic information on whether a certain output section has been activated
267 ! or not, and on whether it has been activated in the Cube or openPMD variant.
268 ! Create with function cube_or_openpmd(), see there for further details.
269 TYPE cp_section_key
270 CHARACTER(len=default_string_length) :: relative_section_key = "" ! e.g. PRINT%MO_CUBES
271 CHARACTER(len=default_string_length) :: absolute_section_key = "" ! e.g. DFT%PRINT%MO_CUBES
272 CHARACTER(len=7) :: format_name = "" ! 'openPMD' or 'Cube', for logging
273 INTEGER :: grid_output = -1 ! either 1 for grid_output_cubes or 2 for grid_output_openpmd
274 LOGICAL :: do_output = .false.
275 CONTAINS
276 ! Open a file as either Cube or openPMD
277 PROCEDURE, PUBLIC :: print_key_unit_nr => cp_forward_print_key_unit_nr
278 ! Write either to the Cube or openPMD file
279 PROCEDURE, PUBLIC :: write_pw => cp_forward_write_pw
280 ! Close either the Cube or openPMD file
281 PROCEDURE, PUBLIC :: print_key_finished_output => cp_forward_print_key_finished_output
282 ! Helpers
283 PROCEDURE, PUBLIC :: do_openpmd => cp_section_key_do_openpmd
284 PROCEDURE, PUBLIC :: do_cubes => cp_section_key_do_cubes
285 PROCEDURE, PUBLIC :: concat_to_relative => cp_section_key_concat_to_relative
286 PROCEDURE, PUBLIC :: concat_to_absolute => cp_section_key_concat_to_absolute
287 END TYPE cp_section_key
288
289CONTAINS
290
291! **************************************************************************************************
292!> \brief Collects the effective core charge for every atom in a QS environment
293!> \param qs_env the QS environment
294!> \param zcharge effective core charges ordered by atom index
295! **************************************************************************************************
296 SUBROUTINE get_effective_core_charges(qs_env, zcharge)
297 TYPE(qs_environment_type), POINTER :: qs_env
298 REAL(KIND=dp), ALLOCATABLE, DIMENSION(:), &
299 INTENT(OUT) :: zcharge
300
301 INTEGER :: iat, iatom, ikind, nat, natom, nkind
302 REAL(KIND=dp) :: zeff
303 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
304 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
305
306 CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, &
307 nkind=nkind, natom=natom)
308 ALLOCATE (zcharge(natom))
309 DO ikind = 1, nkind
310 CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff)
311 CALL get_atomic_kind(atomic_kind_set(ikind), natom=nat)
312 DO iatom = 1, nat
313 iat = atomic_kind_set(ikind)%atom_list(iatom)
314 zcharge(iat) = zeff
315 END DO
316 END DO
317 END SUBROUTINE get_effective_core_charges
318
319! **************************************************************************************************
320!> \brief Append `extend_by` to the absolute path of the base section.
321!> \param self ...
322!> \param extend_by ...
323!> \return ...
324! **************************************************************************************************
325 FUNCTION cp_section_key_concat_to_absolute(self, extend_by) RESULT(res)
326 CLASS(cp_section_key), INTENT(IN) :: self
327 CHARACTER(*), INTENT(IN) :: extend_by
328 CHARACTER(len=default_string_length) :: res
329
330 IF (len(trim(extend_by)) > 0 .AND. extend_by(1:1) == "%") THEN
331 res = trim(self%absolute_section_key)//trim(extend_by)
332 ELSE
333 res = trim(self%absolute_section_key)//"%"//trim(extend_by)
334 END IF
335 END FUNCTION cp_section_key_concat_to_absolute
336
337! **************************************************************************************************
338!> \brief Append `extend_by` to the relative path (e.g. without DFT%) of the base section.
339!> \param self ...
340!> \param extend_by ...
341!> \return ...
342! **************************************************************************************************
343 FUNCTION cp_section_key_concat_to_relative(self, extend_by) RESULT(res)
344 CLASS(cp_section_key), INTENT(IN) :: self
345 CHARACTER(*), INTENT(IN) :: extend_by
346 CHARACTER(len=default_string_length) :: res
347
348 IF (len(trim(extend_by)) > 0 .AND. extend_by(1:1) == "%") THEN
349 res = trim(self%relative_section_key)//trim(extend_by)
350 ELSE
351 res = trim(self%relative_section_key)//"%"//trim(extend_by)
352 END IF
353 END FUNCTION cp_section_key_concat_to_relative
354
355! **************************************************************************************************
356!> \brief Is Cube output active for the current base section?
357!> \param self ...
358!> \return ...
359! **************************************************************************************************
360 FUNCTION cp_section_key_do_cubes(self) RESULT(res)
361 CLASS(cp_section_key) :: self
362 LOGICAL :: res
363
364 res = self%do_output .AND. self%grid_output == grid_output_cubes
365 END FUNCTION cp_section_key_do_cubes
366
367! **************************************************************************************************
368!> \brief Is openPMD output active for the current base section?
369!> \param self ...
370!> \return ...
371! **************************************************************************************************
372 FUNCTION cp_section_key_do_openpmd(self) RESULT(res)
373 CLASS(cp_section_key) :: self
374 LOGICAL :: res
375
376 res = self%do_output .AND. self%grid_output == grid_output_openpmd
377 END FUNCTION cp_section_key_do_openpmd
378
379! **************************************************************************************************
380!> \brief Forwards to either `cp_print_key_unit_nr` or `cp_openpmd_print_key_unit_nr`,
381!> depending on the configuration of the current base section.
382!> Opens either a Cube or openPMD output file
383!> \param self ...
384!> \param logger ...
385!> \param basis_section ...
386!> \param print_key_path ...
387!> \param extension ...
388!> \param middle_name ...
389!> \param local ...
390!> \param log_filename ...
391!> \param ignore_should_output ...
392!> \param file_form ...
393!> \param file_position ...
394!> \param file_action ...
395!> \param file_status ...
396!> \param do_backup ...
397!> \param on_file ...
398!> \param is_new_file ...
399!> \param mpi_io ...
400!> \param fout ...
401!> \param openpmd_basename ...
402!> \param openpmd_unit_dimension ...
403!> \param openpmd_unit_si ...
404!> \param sim_time ...
405!> \return ...
406! **************************************************************************************************
407 FUNCTION cp_forward_print_key_unit_nr( &
408 self, &
409 logger, &
410 basis_section, &
411 print_key_path, &
412 extension, &
413 middle_name, &
414 local, &
415 log_filename, &
416 ignore_should_output, &
417 file_form, &
418 file_position, &
419 file_action, &
420 file_status, &
421 do_backup, &
422 on_file, &
423 is_new_file, &
424 mpi_io, &
425 fout, &
426 openpmd_basename, &
427 openpmd_unit_dimension, &
428 openpmd_unit_si, &
429 sim_time) RESULT(res)
430
431 CLASS(cp_section_key), INTENT(IN) :: self
432 TYPE(cp_logger_type), POINTER :: logger
433 TYPE(section_vals_type), INTENT(IN) :: basis_section
434 CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path
435 CHARACTER(len=*), INTENT(IN) :: extension
436 CHARACTER(len=*), INTENT(IN), OPTIONAL :: middle_name
437 LOGICAL, INTENT(IN), OPTIONAL :: local, log_filename, ignore_should_output
438 CHARACTER(len=*), INTENT(IN), OPTIONAL :: file_form, file_position, file_action, &
439 file_status
440 LOGICAL, INTENT(IN), OPTIONAL :: do_backup, on_file
441 LOGICAL, INTENT(OUT), OPTIONAL :: is_new_file
442 LOGICAL, INTENT(INOUT), OPTIONAL :: mpi_io
443 CHARACTER(len=default_path_length), INTENT(OUT), &
444 OPTIONAL :: fout
445 CHARACTER(len=*), INTENT(IN), OPTIONAL :: openpmd_basename
446 REAL(kind=dp), DIMENSION(7), OPTIONAL, INTENT(IN) :: openpmd_unit_dimension
447 REAL(kind=dp), OPTIONAL, INTENT(IN) :: openpmd_unit_si
448 REAL(kind=dp), OPTIONAL, INTENT(IN) :: sim_time
449 INTEGER :: res
450
451 IF (self%grid_output == grid_output_cubes) THEN
452 res = cp_print_key_unit_nr( &
453 logger, basis_section, print_key_path, extension=extension, &
454 middle_name=middle_name, local=local, log_filename=log_filename, &
455 ignore_should_output=ignore_should_output, file_form=file_form, &
456 file_position=file_position, file_action=file_action, &
457 file_status=file_status, do_backup=do_backup, on_file=on_file, &
458 is_new_file=is_new_file, mpi_io=mpi_io, fout=fout)
459 ELSE
461 logger, &
462 basis_section, &
463 print_key_path, &
464 middle_name=middle_name, &
465 ignore_should_output=ignore_should_output, &
466 mpi_io=mpi_io, &
467 fout=fout, &
468 openpmd_basename=openpmd_basename, &
469 openpmd_unit_dimension=openpmd_unit_dimension, &
470 openpmd_unit_si=openpmd_unit_si, &
471 sim_time=sim_time)
472 END IF
473 END FUNCTION cp_forward_print_key_unit_nr
474
475! **************************************************************************************************
476!> \brief Forwards to either `cp_pw_to_cube` or `cp_pw_to_openpmd`,
477!> depending on the configuration of the current base section.
478!> Writes data to either a Cube or an openPMD file.
479!> \param self ...
480!> \param pw ...
481!> \param unit_nr ...
482!> \param title ...
483!> \param particles ...
484!> \param zeff ...
485!> \param stride ...
486!> \param max_file_size_mb ...
487!> \param zero_tails ...
488!> \param silent ...
489!> \param mpi_io ...
490! **************************************************************************************************
491 SUBROUTINE cp_forward_write_pw( &
492 self, &
493 pw, &
494 unit_nr, &
495 title, &
496 particles, &
497 zeff, &
498 stride, &
499 max_file_size_mb, &
500 zero_tails, &
501 silent, &
502 mpi_io &
503 )
504 CLASS(cp_section_key), INTENT(IN) :: self
505 TYPE(pw_r3d_rs_type), INTENT(IN) :: pw
506 INTEGER, INTENT(IN) :: unit_nr
507 CHARACTER(*), INTENT(IN), OPTIONAL :: title
508 TYPE(particle_list_type), POINTER :: particles
509 INTEGER, DIMENSION(:), OPTIONAL, POINTER :: stride
510 REAL(KIND=dp), INTENT(IN), OPTIONAL :: max_file_size_mb
511 LOGICAL, INTENT(IN), OPTIONAL :: zero_tails, silent, mpi_io
512 REAL(KIND=dp), DIMENSION(:), OPTIONAL :: zeff
513
514 IF (self%grid_output == grid_output_cubes) THEN
515 CALL cp_pw_to_cube(pw, unit_nr, title, particles, zeff, stride, max_file_size_mb, zero_tails, silent, mpi_io)
516 ELSE
517 CALL cp_pw_to_openpmd(pw, unit_nr, title, particles, zeff, stride, zero_tails, silent, mpi_io)
518 END IF
519 END SUBROUTINE cp_forward_write_pw
520
521! **************************************************************************************************
522!> \brief Forwards to either `cp_print_key_finished_output` or `cp_openpmd_print_key_finished_output`,
523!> depending on the configuration of the current base section.
524!> Closes either a Cube file or a reference to a section within an openPMD file.
525!> \param self ...
526!> \param unit_nr ...
527!> \param logger ...
528!> \param basis_section ...
529!> \param print_key_path ...
530!> \param local ...
531!> \param ignore_should_output ...
532!> \param on_file ...
533!> \param mpi_io ...
534! **************************************************************************************************
535 SUBROUTINE cp_forward_print_key_finished_output(self, unit_nr, logger, basis_section, &
536 print_key_path, local, ignore_should_output, on_file, &
537 mpi_io)
538 CLASS(cp_section_key), INTENT(IN) :: self
539 INTEGER, INTENT(INOUT) :: unit_nr
540 TYPE(cp_logger_type), POINTER :: logger
541 TYPE(section_vals_type), INTENT(IN) :: basis_section
542 CHARACTER(len=*), INTENT(IN), OPTIONAL :: print_key_path
543 LOGICAL, INTENT(IN), OPTIONAL :: local, ignore_should_output, on_file, &
544 mpi_io
545
546 IF (self%grid_output == grid_output_cubes) THEN
547 CALL cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
548 ELSE
549 CALL cp_openpmd_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, mpi_io)
550 END IF
551 END SUBROUTINE cp_forward_print_key_finished_output
552
553 !
554! **************************************************************************************************
555!> \brief Decides if a particular output routine will write to openPMD, to Cube or to none.
556!> Writing to both is not supported.
557!> The distinction between Cube and openPMD output works such that the output configuration
558!> sections exist as duplicates: E.g. for DFT%PRINT%MO_CUBES,
559!> there additionally exists DFT%PRINT%MO_OPENPMD.
560!> The internal base configuration for such sections is identical; additionally there
561!> exist format-specific options such as APPEND for Cube or OPENPMD_CFG_FILE for openPMD.
562!> The routines in this file alternate between using relative section paths without the
563!> %DFT prefix (e.g. PRINT%MO_CUBES) or absolute section paths with the %DF% prefix
564!> (e.g. DFT%PRINT%MO_CUBES). Call this routine with the relative paths.
565!> \param input ...
566!> \param str_cubes ...
567!> \param str_openpmd ...
568!> \param logger ...
569!> \return ...
570! **************************************************************************************************
571 FUNCTION cube_or_openpmd(input, str_cubes, str_openpmd, logger) RESULT(res)
572 TYPE(section_vals_type), POINTER :: input
573 CHARACTER(len=*), INTENT(IN) :: str_cubes, str_openpmd
574 TYPE(cp_logger_type), POINTER :: logger
575 TYPE(cp_section_key) :: res
576
577 LOGICAL :: do_cubes, do_openpmd
578
579 do_cubes = btest(cp_print_key_should_output( &
580 logger%iter_info, input, &
581 "DFT%"//trim(adjustl(str_cubes))), cp_p_file)
582 do_openpmd = btest(cp_print_key_should_output( &
583 logger%iter_info, input, &
584 "DFT%"//trim(adjustl(str_openpmd))), cp_p_file)
585 ! Having Cube and openPMD output both active should be theoretically possible.
586 ! It would require some extra handling for the unit_nr return values.
587 ! (e.g. returning the Cube unit_nr and internally storing the associated openPMD unit_nr).
588 cpassert(.NOT. (do_cubes .AND. do_openpmd))
589 res%do_output = do_cubes .OR. do_openpmd
590 IF (do_openpmd) THEN
591 res%grid_output = grid_output_openpmd
592 res%relative_section_key = trim(adjustl(str_openpmd))
593 res%format_name = "openPMD"
594 ELSE
595 res%grid_output = grid_output_cubes
596 res%relative_section_key = trim(adjustl(str_cubes))
597 res%format_name = "Cube"
598 END IF
599 res%absolute_section_key = "DFT%"//trim(adjustl(res%relative_section_key))
600 END FUNCTION cube_or_openpmd
601
602! **************************************************************************************************
603!> \brief This section key is named WRITE_CUBE for Cube which does not make much sense
604!> for openPMD, so this key name has to be distinguished.
605!> \param grid_output ...
606!> \return ...
607! **************************************************************************************************
608 FUNCTION section_key_do_write(grid_output) RESULT(res)
609 INTEGER, INTENT(IN) :: grid_output
610 CHARACTER(len=32) :: res
611
612 IF (grid_output == grid_output_cubes) THEN
613 res = "%WRITE_CUBE"
614 ELSE IF (grid_output == grid_output_openpmd) THEN
615 res = "%WRITE_OPENPMD"
616 END IF
617 END FUNCTION section_key_do_write
618
619! **************************************************************************************************
620!> \brief Prints the output message for density file writing
621!> \param output_unit Unit number for output
622!> \param prefix The message prefix (e.g., "The total electron density")
623!> \param e_density_section Section key containing grid_output and format_name
624!> \param filename The actual filename or pattern used
625! **************************************************************************************************
626 SUBROUTINE print_density_output_message(output_unit, prefix, e_density_section, filename)
627 INTEGER, INTENT(IN) :: output_unit
628 CHARACTER(len=*), INTENT(IN) :: prefix
629 TYPE(cp_section_key), INTENT(IN) :: e_density_section
630 CHARACTER(len=*), INTENT(IN) :: filename
631
632 IF (e_density_section%grid_output == grid_output_openpmd) THEN
633 WRITE (unit=output_unit, fmt="(/,T2,A)") &
634 trim(prefix)//" is written in " &
635 //e_density_section%format_name &
636 //" file format to the file / file pattern:", &
637 trim(filename)
638 ELSE
639 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
640 trim(prefix)//" is written in " &
641 //e_density_section%format_name &
642 //" file format to the file:", &
643 trim(filename)
644 END IF
645 END SUBROUTINE print_density_output_message
646
647! **************************************************************************************************
648!> \brief collects possible post - scf calculations and prints info / computes properties.
649!> \param qs_env the qs_env in which the qs_env lives
650!> \param wf_type ...
651!> \param do_mp2 ...
652!> \par History
653!> 02.2003 created [fawzi]
654!> 10.2004 moved here from qs_scf [Joost VandeVondele]
655!> started splitting out different subroutines
656!> 10.2015 added header for wave-function correlated methods [Vladimir Rybkin]
657!> \author fawzi
658!> \note
659!> this function changes mo_eigenvectors and mo_eigenvalues, depending on the print keys.
660!> In particular, MO_CUBES causes the MOs to be rotated to make them eigenstates of the KS
661!> matrix, and mo_eigenvalues is updated accordingly. This can, for unconverged wavefunctions,
662!> change afterwards slightly the forces (hence small numerical differences between MD
663!> with and without the debug print level). Ideally this should not happen...
664! **************************************************************************************************
665 SUBROUTINE scf_post_calculation_gpw(qs_env, wf_type, do_mp2)
666
667 TYPE(qs_environment_type), POINTER :: qs_env
668 CHARACTER(6), OPTIONAL :: wf_type
669 LOGICAL, OPTIONAL :: do_mp2
670
671 CHARACTER(len=*), PARAMETER :: routinen = 'scf_post_calculation_gpw', &
672 warning_cube_kpoint = "Print MO cubes not implemented for k-point calculations", &
673 warning_openpmd_kpoint = "Writing to openPMD not implemented for k-point calculations"
674
675 INTEGER :: handle, homo, ispin, min_lumos, n_rep, &
676 nchk_nmoloc, nhomo, nlumo, nlumo_stm, &
677 nlumos, nmo, nspins, output_unit, &
678 unit_nr
679 INTEGER, DIMENSION(:, :, :), POINTER :: marked_states
680 LOGICAL :: check_write, compute_lumos, do_homo, do_kpoints, do_mixed, do_stm, &
681 do_wannier_cubes, has_homo, has_lumo, loc_explicit, loc_print_explicit, my_do_mp2, &
682 my_localized_wfn, p_loc, p_loc_homo, p_loc_lumo, p_loc_mixed
683 REAL(dp) :: e_kin
684 REAL(kind=dp) :: gap, homo_lumo(2, 2), total_zeff_corr
685 REAL(kind=dp), DIMENSION(:), POINTER :: mo_eigenvalues
686 TYPE(admm_type), POINTER :: admm_env
687 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
688 TYPE(cp_1d_r_p_type), DIMENSION(:), POINTER :: mixed_evals, occupied_evals, &
689 unoccupied_evals, unoccupied_evals_stm
690 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: mixed_orbs, occupied_orbs
691 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:), &
692 TARGET :: homo_localized, lumo_localized, &
693 mixed_localized
694 TYPE(cp_fm_type), DIMENSION(:), POINTER :: lumo_ptr, mo_loc_history, &
695 unoccupied_orbs, unoccupied_orbs_stm
696 TYPE(cp_fm_type), POINTER :: mo_coeff
697 TYPE(cp_logger_type), POINTER :: logger
698 TYPE(cp_section_key) :: mo_section
699 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_rmpv, matrix_p_mp2, matrix_s, &
700 mo_derivs
701 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: kinetic_m, rho_ao
702 TYPE(dft_control_type), POINTER :: dft_control
703 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
704 TYPE(molecule_type), POINTER :: molecule_set(:)
705 TYPE(mp_para_env_type), POINTER :: para_env
706 TYPE(particle_list_type), POINTER :: particles
707 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
708 TYPE(pw_c1d_gs_type) :: wf_g
709 TYPE(pw_env_type), POINTER :: pw_env
710 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
711 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
712 TYPE(pw_r3d_rs_type) :: wf_r
713 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
714 TYPE(qs_loc_env_type), POINTER :: qs_loc_env_homo, qs_loc_env_lumo, &
715 qs_loc_env_mixed
716 TYPE(qs_rho_type), POINTER :: rho
717 TYPE(qs_scf_env_type), POINTER :: scf_env
718 TYPE(qs_subsys_type), POINTER :: subsys
719 TYPE(rtp_control_type), POINTER :: rtp_control
720 TYPE(scf_control_type), POINTER :: scf_control
721 TYPE(section_vals_type), POINTER :: dft_section, input, loc_print_section, &
722 localize_section, print_key, &
723 stm_section
724
725 CALL timeset(routinen, handle)
726
727 logger => cp_get_default_logger()
728 output_unit = cp_logger_get_default_io_unit(logger)
729
730 ! Print out the type of wavefunction to distinguish between SCF and post-SCF
731 my_do_mp2 = .false.
732 IF (PRESENT(do_mp2)) my_do_mp2 = do_mp2
733 IF (PRESENT(wf_type)) THEN
734 IF (output_unit > 0) THEN
735 WRITE (unit=output_unit, fmt='(/,(T1,A))') repeat("-", 40)
736 WRITE (unit=output_unit, fmt='(/,(T3,A,T19,A,T25,A))') "Properties from ", wf_type, " density"
737 WRITE (unit=output_unit, fmt='(/,(T1,A))') repeat("-", 40)
738 END IF
739 END IF
740
741 ! Writes the data that is already available in qs_env
742 CALL get_qs_env(qs_env, scf_env=scf_env)
743
744 my_localized_wfn = .false.
745 NULLIFY (admm_env, dft_control, pw_env, auxbas_pw_pool, pw_pools, mos, rho, &
746 mo_coeff, ks_rmpv, matrix_s, qs_loc_env_homo, qs_loc_env_lumo, scf_control, &
747 unoccupied_orbs, mo_eigenvalues, unoccupied_evals, &
748 unoccupied_evals_stm, molecule_set, mo_derivs, &
749 subsys, particles, input, print_key, kinetic_m, marked_states, &
750 mixed_evals, qs_loc_env_mixed)
751 NULLIFY (lumo_ptr, rho_ao)
752
753 has_homo = .false.
754 has_lumo = .false.
755 p_loc = .false.
756 p_loc_homo = .false.
757 p_loc_lumo = .false.
758 p_loc_mixed = .false.
759
760 cpassert(ASSOCIATED(scf_env))
761 cpassert(ASSOCIATED(qs_env))
762 ! Here we start with data that needs a postprocessing...
763 CALL get_qs_env(qs_env, &
764 dft_control=dft_control, &
765 molecule_set=molecule_set, &
766 scf_control=scf_control, &
767 do_kpoints=do_kpoints, &
768 input=input, &
769 subsys=subsys, &
770 rho=rho, &
771 pw_env=pw_env, &
772 particle_set=particle_set, &
773 atomic_kind_set=atomic_kind_set, &
774 qs_kind_set=qs_kind_set)
775 rtp_control => dft_control%rtp_control
776 CALL qs_subsys_get(subsys, particles=particles)
777
778 CALL qs_rho_get(rho, rho_ao_kp=rho_ao)
779
780 IF (my_do_mp2) THEN
781 ! Get the HF+MP2 density
782 CALL get_qs_env(qs_env, matrix_p_mp2=matrix_p_mp2)
783 DO ispin = 1, dft_control%nspins
784 CALL dbcsr_add(rho_ao(ispin, 1)%matrix, matrix_p_mp2(ispin)%matrix, 1.0_dp, 1.0_dp)
785 END DO
786 CALL qs_rho_update_rho(rho, qs_env=qs_env)
787 CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.true.)
788 ! In MP2 case update the Hartree potential
789 CALL update_hartree_with_mp2(rho, qs_env)
790 END IF
791
792 CALL write_available_results(qs_env, scf_env)
793
794 ! **** the kinetic energy
795 IF (cp_print_key_should_output(logger%iter_info, input, &
796 "DFT%PRINT%KINETIC_ENERGY") /= 0) THEN
797 CALL get_qs_env(qs_env, kinetic_kp=kinetic_m)
798 cpassert(ASSOCIATED(kinetic_m))
799 cpassert(ASSOCIATED(kinetic_m(1, 1)%matrix))
800 CALL calculate_ptrace(kinetic_m, rho_ao, e_kin, dft_control%nspins)
801 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%KINETIC_ENERGY", &
802 extension=".Log")
803 IF (unit_nr > 0) THEN
804 WRITE (unit_nr, '(T3,A,T55,F25.14)') "Electronic kinetic energy:", e_kin
805 END IF
806 CALL cp_print_key_finished_output(unit_nr, logger, input, &
807 "DFT%PRINT%KINETIC_ENERGY")
808 END IF
809
810 ! Atomic Charges that require further computation
811 CALL qs_scf_post_charges(input, logger, qs_env)
812
813 ! Moments of charge distribution
814 CALL qs_scf_post_moments(input, logger, qs_env, output_unit)
815
816 CALL qs_scf_post_fod(input, logger, qs_env, output_unit)
817
818 ! Determine if we need to computer properties using the localized centers
819 dft_section => section_vals_get_subs_vals(input, "DFT")
820 localize_section => section_vals_get_subs_vals(dft_section, "LOCALIZE")
821 loc_print_section => section_vals_get_subs_vals(localize_section, "PRINT")
822 CALL section_vals_get(localize_section, explicit=loc_explicit)
823 CALL section_vals_get(loc_print_section, explicit=loc_print_explicit)
824
825 ! Print_keys controlled by localization
826 IF (loc_print_explicit) THEN
827 print_key => section_vals_get_subs_vals(loc_print_section, "MOLECULAR_DIPOLES")
828 p_loc = btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
829 print_key => section_vals_get_subs_vals(loc_print_section, "TOTAL_DIPOLE")
830 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
831 print_key => section_vals_get_subs_vals(loc_print_section, "WANNIER_CENTERS")
832 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
833 print_key => section_vals_get_subs_vals(loc_print_section, "WANNIER_SPREADS")
834 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
835 print_key => section_vals_get_subs_vals(loc_print_section, "WANNIER_CUBES")
836 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
837 print_key => section_vals_get_subs_vals(loc_print_section, "MOLECULAR_STATES")
838 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
839 print_key => section_vals_get_subs_vals(loc_print_section, "MOLECULAR_MOMENTS")
840 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
841 print_key => section_vals_get_subs_vals(loc_print_section, "LOCALIZED_MOMENTS")
842 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
843 print_key => section_vals_get_subs_vals(loc_print_section, "WANNIER_STATES")
844 p_loc = p_loc .OR. btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)
845 ELSE
846 p_loc = .false.
847 END IF
848 IF (loc_explicit) THEN
849 p_loc_homo = (section_get_ival(localize_section, "STATES") == do_loc_homo .OR. &
850 section_get_ival(localize_section, "STATES") == do_loc_both) .AND. p_loc
851 p_loc_lumo = (section_get_ival(localize_section, "STATES") == do_loc_lumo .OR. &
852 section_get_ival(localize_section, "STATES") == do_loc_both) .AND. p_loc
853 p_loc_mixed = (section_get_ival(localize_section, "STATES") == do_loc_mixed) .AND. p_loc
854 CALL section_vals_val_get(localize_section, "LIST_UNOCCUPIED", n_rep_val=n_rep)
855 ELSE
856 p_loc_homo = .false.
857 p_loc_lumo = .false.
858 p_loc_mixed = .false.
859 n_rep = 0
860 END IF
861
862 IF (n_rep == 0 .AND. p_loc_lumo) THEN
863 CALL cp_abort(__location__, "No LIST_UNOCCUPIED was specified, "// &
864 "therefore localization of unoccupied states will be skipped!")
865 p_loc_lumo = .false.
866 END IF
867
868 ! Control for STM
869 stm_section => section_vals_get_subs_vals(input, "DFT%PRINT%STM")
870 CALL section_vals_get(stm_section, explicit=do_stm)
871 nlumo_stm = 0
872 IF (do_stm) nlumo_stm = section_get_ival(stm_section, "NLUMO")
873
874 ! check for CUBES or openPMD (MOs and WANNIERS)
875 mo_section = cube_or_openpmd(input, str_mo_cubes, str_mo_openpmd, logger)
876
877 IF (loc_print_explicit) THEN
878 do_wannier_cubes = btest(cp_print_key_should_output(logger%iter_info, loc_print_section, &
879 "WANNIER_CUBES"), cp_p_file)
880 ELSE
881 do_wannier_cubes = .false.
882 END IF
883 nlumo = section_get_ival(dft_section, mo_section%concat_to_relative("%NLUMO"))
884 nhomo = section_get_ival(dft_section, mo_section%concat_to_relative("%NHOMO"))
885
886 ! Setup the grids needed to compute a wavefunction given a vector..
887 IF (((mo_section%do_output .OR. do_wannier_cubes) .AND. (nlumo /= 0 .OR. nhomo /= 0)) .OR. p_loc) THEN
888 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
889 pw_pools=pw_pools)
890 CALL auxbas_pw_pool%create_pw(wf_r)
891 CALL auxbas_pw_pool%create_pw(wf_g)
892 END IF
893
894 IF (dft_control%restricted) THEN
895 !For ROKS useful only first term
896 nspins = 1
897 ELSE
898 nspins = dft_control%nspins
899 END IF
900 !Some info about ROKS
901 IF (dft_control%restricted .AND. (mo_section%do_output .OR. p_loc_homo)) THEN
902 CALL cp_abort(__location__, "Unclear how we define MOs / localization in the restricted case ... ")
903 ! It is possible to obtain Wannier centers for ROKS without rotations for SINGLE OCCUPIED ORBITALS
904 END IF
905 ! Makes the MOs eigenstates, computes eigenvalues, write cubes
906 IF (do_kpoints) THEN
907 cpwarn_if(mo_section%do_cubes(), warning_cube_kpoint)
908 cpwarn_if(mo_section%do_openpmd(), warning_openpmd_kpoint)
909 ELSE
910 CALL get_qs_env(qs_env, &
911 mos=mos, &
912 matrix_ks=ks_rmpv)
913 IF ((mo_section%do_output .AND. nhomo /= 0) .OR. do_stm) THEN
914 CALL get_qs_env(qs_env, mo_derivs=mo_derivs)
915 IF (dft_control%do_admm) THEN
916 CALL get_qs_env(qs_env, admm_env=admm_env)
917 CALL make_mo_eig(mos, nspins, ks_rmpv, scf_control, mo_derivs, admm_env=admm_env)
918 ELSE
919 IF (dft_control%hairy_probes) THEN
920 scf_control%smear%do_smear = .false.
921 CALL make_mo_eig(mos, dft_control%nspins, ks_rmpv, scf_control, mo_derivs, &
922 hairy_probes=dft_control%hairy_probes, &
923 probe=dft_control%probe)
924 ELSE
925 CALL make_mo_eig(mos, dft_control%nspins, ks_rmpv, scf_control, mo_derivs)
926 END IF
927 END IF
928 DO ispin = 1, dft_control%nspins
929 CALL get_mo_set(mo_set=mos(ispin), eigenvalues=mo_eigenvalues, homo=homo)
930 homo_lumo(ispin, 1) = mo_eigenvalues(homo)
931 END DO
932 has_homo = .true.
933 END IF
934 IF (mo_section%do_output .AND. nhomo /= 0) THEN
935 DO ispin = 1, nspins
936 ! Prints the cube files of OCCUPIED ORBITALS
937 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, &
938 eigenvalues=mo_eigenvalues, homo=homo, nmo=nmo)
939 CALL qs_scf_post_occ_cubes(input, dft_section, dft_control, logger, qs_env, &
940 mo_coeff, wf_g, wf_r, particles, homo, ispin, mo_section)
941 END DO
942 END IF
943 END IF
944
945 ! Initialize the localization environment, needed e.g. for wannier functions and molecular states
946 ! Gets localization info for the occupied orbs
947 ! - Possibly gets wannier functions
948 ! - Possibly gets molecular states
949 IF (p_loc_homo) THEN
950 IF (do_kpoints) THEN
951 cpwarn("Localization not implemented for k-point calculations!")
952 ELSE IF (dft_control%restricted &
953 .AND. (section_get_ival(localize_section, "METHOD") /= do_loc_none) &
954 .AND. (section_get_ival(localize_section, "METHOD") /= do_loc_jacobi)) THEN
955 cpabort("ROKS works only with LOCALIZE METHOD NONE or JACOBI")
956 ELSE
957 ALLOCATE (occupied_orbs(dft_control%nspins))
958 ALLOCATE (occupied_evals(dft_control%nspins))
959 ALLOCATE (homo_localized(dft_control%nspins))
960 DO ispin = 1, dft_control%nspins
961 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, &
962 eigenvalues=mo_eigenvalues)
963 occupied_orbs(ispin) = mo_coeff
964 occupied_evals(ispin)%array => mo_eigenvalues
965 CALL cp_fm_create(homo_localized(ispin), occupied_orbs(ispin)%matrix_struct)
966 CALL cp_fm_to_fm(occupied_orbs(ispin), homo_localized(ispin))
967 END DO
968
969 CALL get_qs_env(qs_env, mo_loc_history=mo_loc_history)
970 do_homo = .true.
971
972 ALLOCATE (qs_loc_env_homo)
973 CALL qs_loc_env_create(qs_loc_env_homo)
974 CALL qs_loc_control_init(qs_loc_env_homo, localize_section, do_homo=do_homo)
975 CALL qs_loc_init(qs_env, qs_loc_env_homo, localize_section, homo_localized, do_homo, &
976 mo_section%do_output, mo_loc_history=mo_loc_history)
977 CALL get_localization_info(qs_env, qs_loc_env_homo, localize_section, homo_localized, &
978 wf_r, wf_g, particles, occupied_orbs, occupied_evals, marked_states)
979
980 !retain the homo_localized for future use
981 IF (qs_loc_env_homo%localized_wfn_control%use_history) THEN
982 CALL retain_history(mo_loc_history, homo_localized)
983 CALL set_qs_env(qs_env, mo_loc_history=mo_loc_history)
984 END IF
985
986 !write restart for localization of occupied orbitals
987 CALL loc_write_restart(qs_loc_env_homo, loc_print_section, mos, &
988 homo_localized, do_homo)
989 CALL cp_fm_release(homo_localized)
990 DEALLOCATE (occupied_orbs)
991 DEALLOCATE (occupied_evals)
992 ! Print Total Dipole if the localization has been performed
993 IF (qs_loc_env_homo%do_localize) THEN
994 CALL loc_dipole(input, dft_control, qs_loc_env_homo, logger, qs_env)
995 END IF
996 END IF
997 END IF
998
999 ! Gets the lumos, and eigenvalues for the lumos, and localize them if requested
1000 IF (do_kpoints) THEN
1001 IF (mo_section%do_output .OR. p_loc_lumo) THEN
1002 ! nothing at the moment, not implemented
1003 cpwarn("Localization and MO related output not implemented for k-point calculations!")
1004 END IF
1005 ELSE
1006 compute_lumos = mo_section%do_output .AND. nlumo /= 0
1007 compute_lumos = compute_lumos .OR. p_loc_lumo
1008
1009 DO ispin = 1, dft_control%nspins
1010 CALL get_mo_set(mo_set=mos(ispin), homo=homo, nmo=nmo)
1011 compute_lumos = compute_lumos .AND. homo == nmo
1012 END DO
1013
1014 IF (mo_section%do_output .AND. .NOT. compute_lumos) THEN
1015
1016 nlumo = section_get_ival(dft_section, mo_section%concat_to_relative("%NLUMO"))
1017 DO ispin = 1, dft_control%nspins
1018
1019 CALL get_mo_set(mo_set=mos(ispin), homo=homo, nmo=nmo, eigenvalues=mo_eigenvalues)
1020 IF (nlumo > nmo - homo) THEN
1021 ! this case not yet implemented
1022 ELSE
1023 IF (nlumo == -1) THEN
1024 nlumo = nmo - homo
1025 END IF
1026 IF (output_unit > 0) WRITE (output_unit, *) " "
1027 IF (output_unit > 0) WRITE (output_unit, *) " Lowest eigenvalues of the unoccupied subspace spin ", ispin
1028 IF (output_unit > 0) WRITE (output_unit, *) "---------------------------------------------"
1029 IF (output_unit > 0) WRITE (output_unit, '(4(1X,1F16.8))') mo_eigenvalues(homo + 1:homo + nlumo)
1030
1031 ! Prints the cube files of UNOCCUPIED ORBITALS
1032 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff)
1033 CALL qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_env, &
1034 mo_coeff, wf_g, wf_r, particles, nlumo, homo, ispin, lumo=homo + 1, mo_section=mo_section)
1035 END IF
1036 END DO
1037
1038 END IF
1039
1040 IF (compute_lumos) THEN
1041 check_write = .true.
1042 min_lumos = nlumo
1043 IF (nlumo == 0) check_write = .false.
1044 IF (p_loc_lumo) THEN
1045 do_homo = .false.
1046 ALLOCATE (qs_loc_env_lumo)
1047 CALL qs_loc_env_create(qs_loc_env_lumo)
1048 CALL qs_loc_control_init(qs_loc_env_lumo, localize_section, do_homo=do_homo)
1049 min_lumos = max(maxval(qs_loc_env_lumo%localized_wfn_control%loc_states(:, :)), nlumo)
1050 END IF
1051
1052 ALLOCATE (unoccupied_orbs(dft_control%nspins))
1053 ALLOCATE (unoccupied_evals(dft_control%nspins))
1054 CALL make_lumo_gpw(qs_env, scf_env, unoccupied_orbs, unoccupied_evals, min_lumos, nlumos)
1055 lumo_ptr => unoccupied_orbs
1056 DO ispin = 1, dft_control%nspins
1057 has_lumo = .true.
1058 homo_lumo(ispin, 2) = unoccupied_evals(ispin)%array(1)
1059 CALL get_mo_set(mo_set=mos(ispin), homo=homo)
1060 IF (check_write) THEN
1061 IF (p_loc_lumo .AND. nlumo /= -1) nlumos = min(nlumo, nlumos)
1062 ! Prints the cube files of UNOCCUPIED ORBITALS
1063 CALL qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_env, &
1064 unoccupied_orbs(ispin), wf_g, wf_r, particles, nlumos, homo, ispin, mo_section=mo_section)
1065 END IF
1066 END DO
1067
1068 IF (p_loc_lumo) THEN
1069 ALLOCATE (lumo_localized(dft_control%nspins))
1070 DO ispin = 1, dft_control%nspins
1071 CALL cp_fm_create(lumo_localized(ispin), unoccupied_orbs(ispin)%matrix_struct)
1072 CALL cp_fm_to_fm(unoccupied_orbs(ispin), lumo_localized(ispin))
1073 END DO
1074 CALL qs_loc_init(qs_env, qs_loc_env_lumo, localize_section, lumo_localized, do_homo, mo_section%do_output, &
1075 evals=unoccupied_evals)
1076 CALL qs_loc_env_init(qs_loc_env_lumo, qs_loc_env_lumo%localized_wfn_control, qs_env, &
1077 loc_coeff=unoccupied_orbs)
1078 CALL get_localization_info(qs_env, qs_loc_env_lumo, localize_section, &
1079 lumo_localized, wf_r, wf_g, particles, &
1080 unoccupied_orbs, unoccupied_evals, marked_states)
1081 CALL loc_write_restart(qs_loc_env_lumo, loc_print_section, mos, homo_localized, do_homo, &
1082 evals=unoccupied_evals)
1083 lumo_ptr => lumo_localized
1084 END IF
1085 END IF
1086
1087 IF (has_homo .AND. has_lumo) THEN
1088 IF (output_unit > 0) WRITE (output_unit, *) " "
1089 DO ispin = 1, dft_control%nspins
1090 IF (.NOT. scf_control%smear%do_smear) THEN
1091 gap = homo_lumo(ispin, 2) - homo_lumo(ispin, 1)
1092 IF (output_unit > 0) WRITE (output_unit, '(T2,A,F12.6)') &
1093 "HOMO - LUMO gap [eV] :", gap*evolt
1094 END IF
1095 END DO
1096 END IF
1097 END IF
1098
1099 IF (p_loc_mixed) THEN
1100 IF (do_kpoints) THEN
1101 cpwarn("Localization not implemented for k-point calculations!")
1102 ELSE IF (dft_control%restricted) THEN
1103 IF (output_unit > 0) WRITE (output_unit, *) &
1104 " Unclear how we define MOs / localization in the restricted case... skipping"
1105 ELSE
1106
1107 ALLOCATE (mixed_orbs(dft_control%nspins))
1108 ALLOCATE (mixed_evals(dft_control%nspins))
1109 ALLOCATE (mixed_localized(dft_control%nspins))
1110 DO ispin = 1, dft_control%nspins
1111 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, &
1112 eigenvalues=mo_eigenvalues)
1113 mixed_orbs(ispin) = mo_coeff
1114 mixed_evals(ispin)%array => mo_eigenvalues
1115 CALL cp_fm_create(mixed_localized(ispin), mixed_orbs(ispin)%matrix_struct)
1116 CALL cp_fm_to_fm(mixed_orbs(ispin), mixed_localized(ispin))
1117 END DO
1118
1119 CALL get_qs_env(qs_env, mo_loc_history=mo_loc_history)
1120 do_homo = .false.
1121 do_mixed = .true.
1122 total_zeff_corr = scf_env%sum_zeff_corr
1123 ALLOCATE (qs_loc_env_mixed)
1124 CALL qs_loc_env_create(qs_loc_env_mixed)
1125 CALL qs_loc_control_init(qs_loc_env_mixed, localize_section, do_homo=do_homo, do_mixed=do_mixed)
1126 CALL qs_loc_init(qs_env, qs_loc_env_mixed, localize_section, mixed_localized, do_homo, &
1127 mo_section%do_output, mo_loc_history=mo_loc_history, tot_zeff_corr=total_zeff_corr, &
1129
1130 DO ispin = 1, dft_control%nspins
1131 CALL cp_fm_get_info(mixed_localized(ispin), ncol_global=nchk_nmoloc)
1132 END DO
1133
1134 CALL get_localization_info(qs_env, qs_loc_env_mixed, localize_section, mixed_localized, &
1135 wf_r, wf_g, particles, mixed_orbs, mixed_evals, marked_states)
1136
1137 !retain the homo_localized for future use
1138 IF (qs_loc_env_mixed%localized_wfn_control%use_history) THEN
1139 CALL retain_history(mo_loc_history, mixed_localized)
1140 CALL set_qs_env(qs_env, mo_loc_history=mo_loc_history)
1141 END IF
1142
1143 !write restart for localization of occupied orbitals
1144 CALL loc_write_restart(qs_loc_env_mixed, loc_print_section, mos, &
1145 mixed_localized, do_homo, do_mixed=do_mixed)
1146 CALL cp_fm_release(mixed_localized)
1147 DEALLOCATE (mixed_orbs)
1148 DEALLOCATE (mixed_evals)
1149 END IF
1150 END IF
1151
1152 ! Deallocate grids needed to compute wavefunctions
1153 IF (((mo_section%do_output .OR. do_wannier_cubes) .AND. (nlumo /= 0 .OR. nhomo /= 0)) .OR. p_loc) THEN
1154 CALL auxbas_pw_pool%give_back_pw(wf_r)
1155 CALL auxbas_pw_pool%give_back_pw(wf_g)
1156 END IF
1157
1158 ! Destroy the localization environment
1159 IF (.NOT. do_kpoints) THEN
1160 IF (p_loc_homo) THEN
1161 CALL qs_loc_env_release(qs_loc_env_homo)
1162 DEALLOCATE (qs_loc_env_homo)
1163 END IF
1164 IF (p_loc_lumo) THEN
1165 CALL qs_loc_env_release(qs_loc_env_lumo)
1166 DEALLOCATE (qs_loc_env_lumo)
1167 END IF
1168 IF (p_loc_mixed) THEN
1169 CALL qs_loc_env_release(qs_loc_env_mixed)
1170 DEALLOCATE (qs_loc_env_mixed)
1171 END IF
1172 END IF
1173
1174 ! generate a mix of wfns, and write to a restart
1175 IF (do_kpoints) THEN
1176 ! nothing at the moment, not implemented
1177 ELSE
1178 CALL get_qs_env(qs_env, matrix_s=matrix_s, para_env=para_env)
1179 CALL wfn_mix(mos, particle_set, dft_section, qs_kind_set, para_env, &
1180 output_unit, unoccupied_orbs=lumo_ptr, scf_env=scf_env, &
1181 matrix_s=matrix_s, marked_states=marked_states)
1182
1183 IF (p_loc_lumo) CALL cp_fm_release(lumo_localized)
1184 END IF
1185 IF (ASSOCIATED(marked_states)) THEN
1186 DEALLOCATE (marked_states)
1187 END IF
1188
1189 ! This is just a deallocation for printing MO_CUBES or TDDFPT
1190 IF (.NOT. do_kpoints) THEN
1191 IF (compute_lumos) THEN
1192 DO ispin = 1, dft_control%nspins
1193 DEALLOCATE (unoccupied_evals(ispin)%array)
1194 CALL cp_fm_release(unoccupied_orbs(ispin))
1195 END DO
1196 DEALLOCATE (unoccupied_evals)
1197 DEALLOCATE (unoccupied_orbs)
1198 END IF
1199 END IF
1200
1201 !stm images
1202 IF (do_stm) THEN
1203 IF (do_kpoints) THEN
1204 cpwarn("STM not implemented for k-point calculations!")
1205 ELSE
1206 NULLIFY (unoccupied_orbs_stm, unoccupied_evals_stm)
1207 IF (nlumo_stm > 0) THEN
1208 ALLOCATE (unoccupied_orbs_stm(dft_control%nspins))
1209 ALLOCATE (unoccupied_evals_stm(dft_control%nspins))
1210 CALL make_lumo_gpw(qs_env, scf_env, unoccupied_orbs_stm, unoccupied_evals_stm, &
1211 nlumo_stm, nlumos)
1212 END IF
1213
1214 CALL th_stm_image(qs_env, stm_section, particles, unoccupied_orbs_stm, &
1215 unoccupied_evals_stm)
1216
1217 IF (nlumo_stm > 0) THEN
1218 DO ispin = 1, dft_control%nspins
1219 DEALLOCATE (unoccupied_evals_stm(ispin)%array)
1220 END DO
1221 DEALLOCATE (unoccupied_evals_stm)
1222 CALL cp_fm_release(unoccupied_orbs_stm)
1223 END IF
1224 END IF
1225 END IF
1226
1227 ! Print coherent X-ray diffraction spectrum
1228 CALL qs_scf_post_xray(input, dft_section, logger, qs_env, output_unit)
1229
1230 ! Calculation of Electric Field Gradients
1231 CALL qs_scf_post_efg(input, logger, qs_env)
1232
1233 ! Calculation of ET
1234 CALL qs_scf_post_et(input, qs_env, dft_control)
1235
1236 ! Calculation of EPR Hyperfine Coupling Tensors
1237 CALL qs_scf_post_epr(input, logger, qs_env)
1238
1239 ! Calculation of properties needed for BASIS_MOLOPT optimizations
1240 CALL qs_scf_post_molopt(input, logger, qs_env)
1241
1242 ! Calculate ELF
1243 CALL qs_scf_post_elf(input, logger, qs_env)
1244
1245 ! Use Wannier90 interface
1246 CALL wannier90_interface(input, logger, qs_env)
1247
1248 IF (my_do_mp2) THEN
1249 ! Get everything back
1250 DO ispin = 1, dft_control%nspins
1251 CALL dbcsr_add(rho_ao(ispin, 1)%matrix, matrix_p_mp2(ispin)%matrix, 1.0_dp, -1.0_dp)
1252 END DO
1253 CALL qs_rho_update_rho(rho, qs_env=qs_env)
1254 CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.true.)
1255 END IF
1256
1258
1259 CALL timestop(handle)
1260
1261 END SUBROUTINE scf_post_calculation_gpw
1262
1263! **************************************************************************************************
1264!> \brief Gets the LUMOs and their eigenvalues for all spin channels.
1265!> \param qs_env ...
1266!> \param scf_env ...
1267!> \param unoccupied_orbs ...
1268!> \param unoccupied_evals ...
1269!> \param nlumo ...
1270!> \param nlumos ...
1271! **************************************************************************************************
1272 SUBROUTINE make_lumo_gpw(qs_env, scf_env, unoccupied_orbs, unoccupied_evals, nlumo, nlumos)
1273
1274 TYPE(qs_environment_type), POINTER :: qs_env
1275 TYPE(qs_scf_env_type), POINTER :: scf_env
1276 TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: unoccupied_orbs
1277 TYPE(cp_1d_r_p_type), DIMENSION(:), POINTER :: unoccupied_evals
1278 INTEGER, INTENT(IN) :: nlumo
1279 INTEGER, INTENT(OUT) :: nlumos
1280
1281 CHARACTER(len=*), PARAMETER :: routinen = 'make_lumo_gpw'
1282
1283 INTEGER :: handle, homo, ispin, n, nao, nmo, &
1284 output_unit
1285 TYPE(admm_type), POINTER :: admm_env
1286 TYPE(cp_blacs_env_type), POINTER :: blacs_env
1287 TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp
1288 TYPE(cp_fm_type), POINTER :: mo_coeff
1289 TYPE(cp_logger_type), POINTER :: logger
1290 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_rmpv, matrix_s
1291 TYPE(dft_control_type), POINTER :: dft_control
1292 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
1293 TYPE(mp_para_env_type), POINTER :: para_env
1294 TYPE(preconditioner_type), POINTER :: local_preconditioner
1295 TYPE(scf_control_type), POINTER :: scf_control
1296
1297 CALL timeset(routinen, handle)
1298
1299 NULLIFY (ks_rmpv, matrix_s, scf_control, dft_control, admm_env, para_env, blacs_env, mos)
1300 CALL get_qs_env(qs_env, &
1301 matrix_ks=ks_rmpv, &
1302 matrix_s=matrix_s, &
1303 scf_control=scf_control, &
1304 dft_control=dft_control, &
1305 admm_env=admm_env, &
1306 para_env=para_env, &
1307 blacs_env=blacs_env, &
1308 mos=mos)
1309
1310 logger => cp_get_default_logger()
1311 output_unit = cp_logger_get_default_io_unit(logger)
1312
1313 DO ispin = 1, dft_control%nspins
1314 NULLIFY (unoccupied_evals(ispin)%array)
1315 IF (output_unit > 0) WRITE (output_unit, *) " "
1316 IF (output_unit > 0) WRITE (output_unit, *) &
1317 " Using OT eigensolver for additional unoccupied orbitals spin ", ispin
1318 IF (output_unit > 0) WRITE (output_unit, *) &
1319 " Lowest Eigenvalues of the unoccupied subspace spin ", ispin
1320 IF (output_unit > 0) WRITE (output_unit, fmt='(1X,A)') "-----------------------------------------------------"
1321 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, homo=homo, nao=nao, nmo=nmo)
1322 CALL cp_fm_get_info(mo_coeff, nrow_global=n)
1323 nlumos = max(1, min(nlumo, nao - nmo))
1324 IF (nlumo == -1) nlumos = nao - nmo
1325 ALLOCATE (unoccupied_evals(ispin)%array(nlumos))
1326 CALL cp_fm_struct_create(fm_struct_tmp, para_env=para_env, context=blacs_env, &
1327 nrow_global=n, ncol_global=nlumos)
1328 CALL cp_fm_create(unoccupied_orbs(ispin), fm_struct_tmp, name="lumos")
1329 CALL cp_fm_struct_release(fm_struct_tmp)
1330 CALL cp_fm_init_random(unoccupied_orbs(ispin), nlumos)
1331
1332 ! FULL_ALL has column-dependent occupied-state weights and cannot be reused here.
1333 NULLIFY (local_preconditioner)
1334 IF (ASSOCIATED(scf_env)) THEN
1335 IF (ASSOCIATED(scf_env%ot_preconditioner)) THEN
1336 local_preconditioner => scf_env%ot_preconditioner(1)%preconditioner
1337 IF (local_preconditioner%in_use == ot_precond_full_all .OR. &
1338 local_preconditioner%in_use == ot_precond_full_all_covariant) THEN
1339 NULLIFY (local_preconditioner)
1340 END IF
1341 END IF
1342 END IF
1343
1344 ! If we do ADMM, we add have to modify the Kohn-Sham matrix
1345 IF (dft_control%do_admm) THEN
1346 CALL admm_correct_for_eigenvalues(ispin, admm_env, ks_rmpv(ispin)%matrix)
1347 END IF
1348
1349 CALL ot_eigensolver(matrix_h=ks_rmpv(ispin)%matrix, matrix_s=matrix_s(1)%matrix, &
1350 matrix_c_fm=unoccupied_orbs(ispin), &
1351 matrix_orthogonal_space_fm=mo_coeff, &
1352 eps_gradient=scf_control%eps_lumos, &
1353 preconditioner=local_preconditioner, &
1354 iter_max=scf_control%max_iter_lumos, &
1355 size_ortho_space=nmo)
1356
1357 CALL calculate_subspace_eigenvalues(unoccupied_orbs(ispin), ks_rmpv(ispin)%matrix, &
1358 unoccupied_evals(ispin)%array, scr=output_unit, &
1359 ionode=output_unit > 0)
1360
1361 ! If we do ADMM, we restore the original Kohn-Sham matrix
1362 IF (dft_control%do_admm) THEN
1363 CALL admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_rmpv(ispin)%matrix)
1364 END IF
1365
1366 END DO
1367
1368 CALL timestop(handle)
1369
1370 END SUBROUTINE make_lumo_gpw
1371
1372! **************************************************************************************************
1373!> \brief Computes and Prints Atomic Charges with several methods
1374!> \param input ...
1375!> \param logger ...
1376!> \param qs_env the qs_env in which the qs_env lives
1377! **************************************************************************************************
1378 SUBROUTINE qs_scf_post_charges(input, logger, qs_env)
1379 TYPE(section_vals_type), POINTER :: input
1380 TYPE(cp_logger_type), POINTER :: logger
1381 TYPE(qs_environment_type), POINTER :: qs_env
1382
1383 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_charges'
1384
1385 INTEGER :: handle, print_level, unit_nr
1386 LOGICAL :: do_kpoints, print_it
1387 TYPE(section_vals_type), POINTER :: density_fit_section, print_key
1388
1389 CALL timeset(routinen, handle)
1390
1391 CALL get_qs_env(qs_env=qs_env, do_kpoints=do_kpoints)
1392
1393 ! Mulliken charges require no further computation and are printed from write_mo_free_results
1394
1395 ! Compute the Lowdin charges
1396 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%LOWDIN")
1397 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
1398 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%LOWDIN", extension=".lowdin", &
1399 log_filename=.false.)
1400 print_level = 1
1401 CALL section_vals_val_get(print_key, "PRINT_GOP", l_val=print_it)
1402 IF (print_it) print_level = 2
1403 CALL section_vals_val_get(print_key, "PRINT_ALL", l_val=print_it)
1404 IF (print_it) print_level = 3
1405 CALL lowdin_population_analysis(qs_env, unit_nr, print_level)
1406 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%LOWDIN")
1407 END IF
1408
1409 ! Compute the RESP charges
1410 CALL resp_fit(qs_env)
1411
1412 ! Compute the Density Derived Atomic Point charges with the Bloechl scheme
1413 print_key => section_vals_get_subs_vals(input, "PROPERTIES%FIT_CHARGE")
1414 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
1415 unit_nr = cp_print_key_unit_nr(logger, input, "PROPERTIES%FIT_CHARGE", extension=".Fitcharge", &
1416 log_filename=.false.)
1417 density_fit_section => section_vals_get_subs_vals(input, "DFT%DENSITY_FITTING")
1418 CALL get_ddapc(qs_env, .false., density_fit_section, iwc=unit_nr)
1419 CALL cp_print_key_finished_output(unit_nr, logger, input, "PROPERTIES%FIT_CHARGE")
1420 END IF
1421
1422 CALL timestop(handle)
1423
1424 END SUBROUTINE qs_scf_post_charges
1425
1426! **************************************************************************************************
1427!> \brief Computes and prints the Cube Files for MO
1428!> \param input ...
1429!> \param dft_section ...
1430!> \param dft_control ...
1431!> \param logger ...
1432!> \param qs_env the qs_env in which the qs_env lives
1433!> \param mo_coeff ...
1434!> \param wf_g ...
1435!> \param wf_r ...
1436!> \param particles ...
1437!> \param homo ...
1438!> \param ispin ...
1439!> \param mo_section ...
1440! **************************************************************************************************
1441 SUBROUTINE qs_scf_post_occ_cubes(input, dft_section, dft_control, logger, qs_env, &
1442 mo_coeff, wf_g, wf_r, particles, homo, ispin, mo_section)
1443 TYPE(section_vals_type), POINTER :: input, dft_section
1444 TYPE(dft_control_type), POINTER :: dft_control
1445 TYPE(cp_logger_type), POINTER :: logger
1446 TYPE(qs_environment_type), POINTER :: qs_env
1447 TYPE(cp_fm_type), INTENT(IN) :: mo_coeff
1448 TYPE(pw_c1d_gs_type), INTENT(INOUT) :: wf_g
1449 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: wf_r
1450 TYPE(particle_list_type), POINTER :: particles
1451 INTEGER, INTENT(IN) :: homo, ispin
1452 TYPE(cp_section_key) :: mo_section
1453
1454 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_occ_cubes'
1455
1456 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube, title
1457 INTEGER :: handle, i, ir, ivector, n_rep, nhomo, &
1458 nlist, unit_nr
1459 INTEGER, DIMENSION(:), POINTER :: list, list_index
1460 LOGICAL :: append_cube, mpi_io
1461 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: zcharge
1462 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1463 TYPE(cell_type), POINTER :: cell
1464 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1465 TYPE(pw_env_type), POINTER :: pw_env
1466 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1467
1468 CALL timeset(routinen, handle)
1469
1470#ifndef __OPENPMD
1471 ! Error should usually be caught earlier as PRINT%MO_OPENPMD is not added to the input section
1472 ! if openPMD is not activated
1473 cpassert(mo_section%grid_output /= grid_output_openpmd)
1474#endif
1475
1476 NULLIFY (list_index)
1477
1478 IF (btest(cp_print_key_should_output(logger%iter_info, dft_section, mo_section%relative_section_key) &
1479 , cp_p_file) .AND. section_get_lval(dft_section, mo_section%concat_to_relative(section_key_do_write(mo_section%grid_output)))) THEN
1480 CALL get_effective_core_charges(qs_env, zcharge)
1481 nhomo = section_get_ival(dft_section, mo_section%concat_to_relative("%NHOMO"))
1482 ! For openPMD, refer to access modes instead of APPEND key
1483 IF (mo_section%grid_output == grid_output_cubes) THEN
1484 append_cube = section_get_lval(dft_section, mo_section%concat_to_relative("%APPEND"))
1485 END IF
1486 my_pos_cube = "REWIND"
1487 IF (append_cube) THEN
1488 my_pos_cube = "APPEND"
1489 END IF
1490 CALL section_vals_val_get(dft_section, mo_section%concat_to_relative("%HOMO_LIST"), n_rep_val=n_rep)
1491 IF (n_rep > 0) THEN ! write the cubes of the list
1492 nlist = 0
1493 DO ir = 1, n_rep
1494 NULLIFY (list)
1495 CALL section_vals_val_get(dft_section, mo_section%concat_to_relative("%HOMO_LIST"), i_rep_val=ir, &
1496 i_vals=list)
1497 IF (ASSOCIATED(list)) THEN
1498 CALL reallocate(list_index, 1, nlist + SIZE(list))
1499 DO i = 1, SIZE(list)
1500 list_index(i + nlist) = list(i)
1501 END DO
1502 nlist = nlist + SIZE(list)
1503 END IF
1504 END DO
1505 ELSE
1506
1507 IF (nhomo == -1) nhomo = homo
1508 nlist = homo - max(1, homo - nhomo + 1) + 1
1509 ALLOCATE (list_index(nlist))
1510 DO i = 1, nlist
1511 list_index(i) = max(1, homo - nhomo + 1) + i - 1
1512 END DO
1513 END IF
1514 DO i = 1, nlist
1515 ivector = list_index(i)
1516 CALL get_qs_env(qs_env=qs_env, &
1517 atomic_kind_set=atomic_kind_set, &
1518 qs_kind_set=qs_kind_set, &
1519 cell=cell, &
1520 particle_set=particle_set, &
1521 pw_env=pw_env)
1522 CALL calculate_wavefunction(mo_coeff, ivector, wf_r, wf_g, atomic_kind_set, qs_kind_set, &
1523 cell, dft_control, particle_set, pw_env)
1524 WRITE (filename, '(a4,I5.5,a1,I1.1)') "WFN_", ivector, "_", ispin
1525 mpi_io = .true.
1526
1527 unit_nr = mo_section%print_key_unit_nr( &
1528 logger, &
1529 input, &
1530 mo_section%absolute_section_key, &
1531 extension=".cube", &
1532 middle_name=trim(filename), &
1533 file_position=my_pos_cube, &
1534 log_filename=.false., &
1535 mpi_io=mpi_io, &
1536 openpmd_basename="dft-mo", &
1537 openpmd_unit_dimension=openpmd_unit_dimension_wavefunction, &
1538 openpmd_unit_si=openpmd_unit_si_wavefunction, &
1539 sim_time=qs_env%sim_time)
1540 WRITE (title, *) "WAVEFUNCTION ", ivector, " spin ", ispin, " i.e. HOMO - ", ivector - homo
1541 CALL mo_section%write_pw(wf_r, unit_nr, title, particles=particles, zeff=zcharge, &
1542 stride=section_get_ivals(dft_section, mo_section%concat_to_relative("%STRIDE")), &
1543 max_file_size_mb=section_get_rval(dft_section, "PRINT%MO_CUBES%MAX_FILE_SIZE_MB"), &
1544 mpi_io=mpi_io)
1545 CALL mo_section%print_key_finished_output(unit_nr, logger, input, mo_section%absolute_section_key, mpi_io=mpi_io)
1546 END DO
1547 IF (ASSOCIATED(list_index)) DEALLOCATE (list_index)
1548 DEALLOCATE (zcharge)
1549 END IF
1550
1551 CALL timestop(handle)
1552
1553 END SUBROUTINE qs_scf_post_occ_cubes
1554
1555! **************************************************************************************************
1556!> \brief Computes and prints the Cube Files for MO
1557!> \param input ...
1558!> \param dft_section ...
1559!> \param dft_control ...
1560!> \param logger ...
1561!> \param qs_env the qs_env in which the qs_env lives
1562!> \param unoccupied_orbs ...
1563!> \param wf_g ...
1564!> \param wf_r ...
1565!> \param particles ...
1566!> \param nlumos ...
1567!> \param homo ...
1568!> \param ispin ...
1569!> \param lumo ...
1570!> \param mo_section ...
1571! **************************************************************************************************
1572 SUBROUTINE qs_scf_post_unocc_cubes(input, dft_section, dft_control, logger, qs_env, &
1573 unoccupied_orbs, wf_g, wf_r, particles, nlumos, homo, ispin, lumo, mo_section)
1574
1575 TYPE(section_vals_type), POINTER :: input, dft_section
1576 TYPE(dft_control_type), POINTER :: dft_control
1577 TYPE(cp_logger_type), POINTER :: logger
1578 TYPE(qs_environment_type), POINTER :: qs_env
1579 TYPE(cp_fm_type), INTENT(IN) :: unoccupied_orbs
1580 TYPE(pw_c1d_gs_type), INTENT(INOUT) :: wf_g
1581 TYPE(pw_r3d_rs_type), INTENT(INOUT) :: wf_r
1582 TYPE(particle_list_type), POINTER :: particles
1583 INTEGER, INTENT(IN) :: nlumos, homo, ispin
1584 INTEGER, INTENT(IN), OPTIONAL :: lumo
1585 TYPE(cp_section_key) :: mo_section
1586
1587 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_unocc_cubes'
1588
1589 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube, title
1590 INTEGER :: handle, ifirst, index_mo, ivector, &
1591 unit_nr
1592 LOGICAL :: append_cube, mpi_io
1593 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: zcharge
1594 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
1595 TYPE(cell_type), POINTER :: cell
1596 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1597 TYPE(pw_env_type), POINTER :: pw_env
1598 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1599
1600 CALL timeset(routinen, handle)
1601
1602#ifndef __OPENPMD
1603 ! Error should usually be caught earlier as PRINT%MO_OPENPMD is not added to the input section
1604 ! if openPMD is not activated
1605 cpassert(mo_section%grid_output /= grid_output_openpmd)
1606#endif
1607
1608 IF (btest(cp_print_key_should_output(logger%iter_info, dft_section, mo_section%relative_section_key), cp_p_file) &
1609 .AND. section_get_lval(dft_section, mo_section%concat_to_relative(section_key_do_write(mo_section%grid_output)))) THEN
1610 CALL get_effective_core_charges(qs_env, zcharge)
1611 NULLIFY (qs_kind_set, particle_set, pw_env, cell)
1612 ! For openPMD, refer to access modes instead of APPEND key
1613 IF (mo_section%grid_output == grid_output_cubes) THEN
1614 append_cube = section_get_lval(dft_section, mo_section%concat_to_relative("%APPEND"))
1615 END IF
1616 my_pos_cube = "REWIND"
1617 IF (append_cube) THEN
1618 my_pos_cube = "APPEND"
1619 END IF
1620 ifirst = 1
1621 IF (PRESENT(lumo)) ifirst = lumo
1622 DO ivector = ifirst, ifirst + nlumos - 1
1623 CALL get_qs_env(qs_env=qs_env, &
1624 atomic_kind_set=atomic_kind_set, &
1625 qs_kind_set=qs_kind_set, &
1626 cell=cell, &
1627 particle_set=particle_set, &
1628 pw_env=pw_env)
1629 CALL calculate_wavefunction(unoccupied_orbs, ivector, wf_r, wf_g, atomic_kind_set, &
1630 qs_kind_set, cell, dft_control, particle_set, pw_env)
1631
1632 IF (ifirst == 1) THEN
1633 index_mo = homo + ivector
1634 ELSE
1635 index_mo = ivector
1636 END IF
1637 WRITE (filename, '(a4,I5.5,a1,I1.1)') "WFN_", index_mo, "_", ispin
1638 mpi_io = .true.
1639
1640 unit_nr = mo_section%print_key_unit_nr( &
1641 logger, &
1642 input, &
1643 mo_section%absolute_section_key, &
1644 extension=".cube", &
1645 middle_name=trim(filename), &
1646 file_position=my_pos_cube, &
1647 log_filename=.false., &
1648 mpi_io=mpi_io, &
1649 openpmd_basename="dft-mo", &
1650 openpmd_unit_dimension=openpmd_unit_dimension_wavefunction, &
1651 openpmd_unit_si=openpmd_unit_si_wavefunction, &
1652 sim_time=qs_env%sim_time)
1653 WRITE (title, *) "WAVEFUNCTION ", index_mo, " spin ", ispin, " i.e. LUMO + ", ifirst + ivector - 2
1654 CALL mo_section%write_pw(wf_r, unit_nr, title, particles=particles, zeff=zcharge, &
1655 stride=section_get_ivals(dft_section, mo_section%concat_to_relative("%STRIDE")), &
1656 max_file_size_mb=section_get_rval(dft_section, "PRINT%MO_CUBES%MAX_FILE_SIZE_MB"), &
1657 mpi_io=mpi_io)
1658 CALL mo_section%print_key_finished_output(unit_nr, logger, input, mo_section%absolute_section_key, mpi_io=mpi_io)
1659
1660 END DO
1661 DEALLOCATE (zcharge)
1662 END IF
1663
1664 CALL timestop(handle)
1665
1666 END SUBROUTINE qs_scf_post_unocc_cubes
1667
1668! **************************************************************************************************
1669!> \brief Computes and prints electric moments
1670!> \param input ...
1671!> \param logger ...
1672!> \param qs_env the qs_env in which the qs_env lives
1673!> \param output_unit ...
1674! **************************************************************************************************
1675 SUBROUTINE qs_scf_post_moments(input, logger, qs_env, output_unit)
1676 TYPE(section_vals_type), POINTER :: input
1677 TYPE(cp_logger_type), POINTER :: logger
1678 TYPE(qs_environment_type), POINTER :: qs_env
1679 INTEGER, INTENT(IN) :: output_unit
1680
1681 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_moments'
1682
1683 CHARACTER(LEN=default_path_length) :: filename
1684 INTEGER :: handle, max_nmo, maxmom, moments_format, &
1685 moments_unit_nr, reference, unit_nr
1686 LOGICAL :: com_nl, do_kg, do_kpoints, magnetic, &
1687 new_file, periodic, second_ref_point, &
1688 vel_reprs
1689 REAL(kind=dp), DIMENSION(:), POINTER :: ref_point
1690 TYPE(section_vals_type), POINTER :: print_key
1691
1692 CALL timeset(routinen, handle)
1693
1694 print_key => section_vals_get_subs_vals(section_vals=input, &
1695 subsection_name="DFT%PRINT%MOMENTS")
1696
1697 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
1698
1699 maxmom = section_get_ival(section_vals=input, &
1700 keyword_name="DFT%PRINT%MOMENTS%MAX_MOMENT")
1701 moments_format = section_get_ival(section_vals=input, &
1702 keyword_name="DFT%PRINT%MOMENTS%FORMAT")
1703 periodic = section_get_lval(section_vals=input, &
1704 keyword_name="DFT%PRINT%MOMENTS%PERIODIC")
1705 reference = section_get_ival(section_vals=input, &
1706 keyword_name="DFT%PRINT%MOMENTS%REFERENCE")
1707 magnetic = section_get_lval(section_vals=input, &
1708 keyword_name="DFT%PRINT%MOMENTS%MAGNETIC")
1709 vel_reprs = section_get_lval(section_vals=input, &
1710 keyword_name="DFT%PRINT%MOMENTS%VEL_REPRS")
1711 com_nl = section_get_lval(section_vals=input, &
1712 keyword_name="DFT%PRINT%MOMENTS%COM_NL")
1713 second_ref_point = section_get_lval(section_vals=input, &
1714 keyword_name="DFT%PRINT%MOMENTS%SECOND_REFERENCE_POINT")
1715 do_kg = section_get_lval(section_vals=input, &
1716 keyword_name="DFT%PRINT%MOMENTS%KG")
1717 max_nmo = section_get_ival(section_vals=input, &
1718 keyword_name="DFT%PRINT%MOMENTS%MAX_NMO")
1719
1720 NULLIFY (ref_point)
1721 CALL section_vals_val_get(input, "DFT%PRINT%MOMENTS%REF_POINT", r_vals=ref_point)
1722 unit_nr = cp_print_key_unit_nr(logger=logger, basis_section=input, &
1723 print_key_path="DFT%PRINT%MOMENTS", extension=".dat", &
1724 middle_name="moments", log_filename=.false., &
1725 is_new_file=new_file)
1726
1727 IF (output_unit > 0) THEN
1728 IF (unit_nr /= output_unit) THEN
1729 INQUIRE (unit=unit_nr, name=filename)
1730 WRITE (unit=output_unit, fmt="(/,T2,A,2(/,T3,A),/)") &
1731 "MOMENTS", "The electric/magnetic moments are written to file:", &
1732 trim(filename)
1733 ELSE IF (moments_format /= moments_format_trajectory) THEN
1734 WRITE (unit=output_unit, fmt="(/,T2,A)") "ELECTRIC/MAGNETIC MOMENTS"
1735 END IF
1736 END IF
1737
1738 CALL get_qs_env(qs_env, do_kpoints=do_kpoints)
1739
1740 IF (moments_format == moments_format_trajectory) THEN
1741 IF (do_kpoints) THEN
1742 cpabort("MOMENTS FORMAT TRAJECTORY is not available for k-point calculations.")
1743 END IF
1744 IF (maxmom /= 1) cpabort("MOMENTS FORMAT TRAJECTORY requires MAX_MOMENT 1.")
1745 IF (magnetic) cpabort("MOMENTS FORMAT TRAJECTORY does not support MAGNETIC moments.")
1746 IF (vel_reprs) cpabort("MOMENTS FORMAT TRAJECTORY does not support VEL_REPRS.")
1747 IF (do_kg) cpabort("MOMENTS FORMAT TRAJECTORY does not support KG moments.")
1748 moments_unit_nr = -1
1749 ELSE
1750 moments_unit_nr = unit_nr
1751 END IF
1752
1753 IF (do_kpoints) THEN
1754 CALL qs_moment_kpoints(qs_env, maxmom, reference, ref_point, max_nmo, moments_unit_nr)
1755 ELSE
1756 IF (periodic) THEN
1757 CALL qs_moment_berry_phase(qs_env, magnetic, maxmom, reference, ref_point, moments_unit_nr)
1758 ELSE
1759 CALL qs_moment_locop(qs_env, magnetic, maxmom, reference, ref_point, moments_unit_nr, vel_reprs, com_nl)
1760 END IF
1761 IF (do_kg) THEN
1762 CALL calculate_kg_moments(qs_env, moments_unit_nr, maxmom, magnetic, vel_reprs, com_nl)
1763 END IF
1764 END IF
1765 IF (moments_format == moments_format_trajectory) THEN
1766 CALL write_moments_trajectory(unit_nr, logger, qs_env, periodic, new_file, "MOMENTS|")
1767 END IF
1768
1769 CALL cp_print_key_finished_output(unit_nr=unit_nr, logger=logger, &
1770 basis_section=input, print_key_path="DFT%PRINT%MOMENTS")
1771
1772 IF (second_ref_point) THEN
1773 reference = section_get_ival(section_vals=input, &
1774 keyword_name="DFT%PRINT%MOMENTS%REFERENCE_2")
1775
1776 NULLIFY (ref_point)
1777 CALL section_vals_val_get(input, "DFT%PRINT%MOMENTS%REF_POINT_2", r_vals=ref_point)
1778 unit_nr = cp_print_key_unit_nr(logger=logger, basis_section=input, &
1779 print_key_path="DFT%PRINT%MOMENTS", extension=".dat", &
1780 middle_name="moments_refpoint_2", log_filename=.false., &
1781 is_new_file=new_file)
1782
1783 IF (output_unit > 0) THEN
1784 IF (unit_nr /= output_unit) THEN
1785 INQUIRE (unit=unit_nr, name=filename)
1786 WRITE (unit=output_unit, fmt="(/,T2,A,2(/,T3,A),/)") &
1787 "MOMENTS", "The electric/magnetic moments for the second reference point are written to file:", &
1788 trim(filename)
1789 ELSE IF (moments_format /= moments_format_trajectory) THEN
1790 WRITE (unit=output_unit, fmt="(/,T2,A)") "ELECTRIC/MAGNETIC MOMENTS"
1791 END IF
1792 END IF
1793 IF (moments_format /= moments_format_trajectory) moments_unit_nr = unit_nr
1794 IF (do_kpoints) THEN
1795 CALL qs_moment_kpoints(qs_env, maxmom, reference, ref_point, max_nmo, moments_unit_nr)
1796 ELSE
1797 IF (periodic) THEN
1798 CALL qs_moment_berry_phase(qs_env, magnetic, maxmom, reference, ref_point, moments_unit_nr)
1799 ELSE
1800 CALL qs_moment_locop(qs_env, magnetic, maxmom, reference, ref_point, &
1801 moments_unit_nr, vel_reprs, com_nl)
1802 END IF
1803 END IF
1804 IF (moments_format == moments_format_trajectory) THEN
1805 CALL write_moments_trajectory(unit_nr, logger, qs_env, periodic, new_file, "MOMENTS_REF2|")
1806 END IF
1807 CALL cp_print_key_finished_output(unit_nr=unit_nr, logger=logger, &
1808 basis_section=input, print_key_path="DFT%PRINT%MOMENTS")
1809 END IF
1810
1811 END IF
1812
1813 CALL timestop(handle)
1814
1815 END SUBROUTINE qs_scf_post_moments
1816
1817! **************************************************************************************************
1818!> \brief Writes one machine-readable electric-dipole record for the current iteration.
1819!> \param unit_nr output unit
1820!> \param logger logger carrying the current iteration levels
1821!> \param qs_env quantum environment containing the dipole result and cell
1822!> \param periodic whether the Berry-phase operator was used
1823!> \param new_file whether the output file has just been created
1824!> \param label record label
1825! **************************************************************************************************
1826 SUBROUTINE write_moments_trajectory(unit_nr, logger, qs_env, periodic, new_file, label)
1827 INTEGER, INTENT(IN) :: unit_nr
1828 TYPE(cp_logger_type), POINTER :: logger
1829 TYPE(qs_environment_type), POINTER :: qs_env
1830 LOGICAL, INTENT(IN) :: periodic, new_file
1831 CHARACTER(LEN=*), INTENT(IN) :: label
1832
1833 CHARACTER(LEN=default_string_length) :: description, iter
1834 REAL(kind=dp), DIMENSION(3) :: dipole
1835 TYPE(cell_type), POINTER :: cell
1836 TYPE(cp_result_type), POINTER :: results
1837
1838 IF (unit_nr <= 0) RETURN
1839
1840 NULLIFY (cell, results)
1841 CALL get_qs_env(qs_env, cell=cell, results=results)
1842 description = "[DIPOLE]"
1843 CALL get_results(results=results, description=description, values=dipole)
1844
1845 IF (new_file) THEN
1846 IF (periodic) THEN
1847 WRITE (unit_nr, "(A)") "# "//trim(label)// &
1848 " iter_level dipole_x dipole_y dipole_z dipole_norm cell_xx cell_xy cell_xz"// &
1849 " cell_yx cell_yy cell_yz cell_zx cell_zy cell_zz [Debye]"
1850 ELSE
1851 WRITE (unit_nr, "(A)") "# "//trim(label)// &
1852 " iter_level dipole_x dipole_y dipole_z dipole_norm [Debye]"
1853 END IF
1854 END IF
1855
1856 iter = cp_iter_string(logger%iter_info)
1857 IF (periodic) THEN
1858 WRITE (unit_nr, "(1X,A,1X,A15,13(1X,ES18.10))") trim(label), iter(1:15), &
1859 dipole*debye, sqrt(sum(dipole**2))*debye, &
1860 cell%hmat(1, :)*debye, cell%hmat(2, :)*debye, cell%hmat(3, :)*debye
1861 ELSE
1862 WRITE (unit_nr, "(1X,A,1X,A15,4(1X,ES18.10))") trim(label), iter(1:15), &
1863 dipole*debye, sqrt(sum(dipole**2))*debye
1864 END IF
1865
1866 END SUBROUTINE write_moments_trajectory
1867
1868! **************************************************************************************************
1869!> \brief Computes and prints the X-ray diffraction spectrum.
1870!> \param input ...
1871!> \param dft_section ...
1872!> \param logger ...
1873!> \param qs_env the qs_env in which the qs_env lives
1874!> \param output_unit ...
1875! **************************************************************************************************
1876 SUBROUTINE qs_scf_post_xray(input, dft_section, logger, qs_env, output_unit)
1877
1878 TYPE(section_vals_type), POINTER :: input, dft_section
1879 TYPE(cp_logger_type), POINTER :: logger
1880 TYPE(qs_environment_type), POINTER :: qs_env
1881 INTEGER, INTENT(IN) :: output_unit
1882
1883 CHARACTER(LEN=*), PARAMETER :: routinen = 'qs_scf_post_xray'
1884
1885 CHARACTER(LEN=default_path_length) :: filename
1886 INTEGER :: handle, unit_nr
1887 REAL(kind=dp) :: q_max
1888 TYPE(section_vals_type), POINTER :: print_key
1889
1890 CALL timeset(routinen, handle)
1891
1892 print_key => section_vals_get_subs_vals(section_vals=input, &
1893 subsection_name="DFT%PRINT%XRAY_DIFFRACTION_SPECTRUM")
1894
1895 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
1896 q_max = section_get_rval(section_vals=dft_section, &
1897 keyword_name="PRINT%XRAY_DIFFRACTION_SPECTRUM%Q_MAX")
1898 unit_nr = cp_print_key_unit_nr(logger=logger, &
1899 basis_section=input, &
1900 print_key_path="DFT%PRINT%XRAY_DIFFRACTION_SPECTRUM", &
1901 extension=".dat", &
1902 middle_name="xrd", &
1903 log_filename=.false.)
1904 IF (output_unit > 0) THEN
1905 INQUIRE (unit=unit_nr, name=filename)
1906 WRITE (unit=output_unit, fmt="(/,/,T2,A)") &
1907 "X-RAY DIFFRACTION SPECTRUM"
1908 IF (unit_nr /= output_unit) THEN
1909 WRITE (unit=output_unit, fmt="(/,T3,A,/,/,T3,A,/)") &
1910 "The coherent X-ray diffraction spectrum is written to the file:", &
1911 trim(filename)
1912 END IF
1913 END IF
1914 CALL xray_diffraction_spectrum(qs_env=qs_env, &
1915 unit_number=unit_nr, &
1916 q_max=q_max)
1917 CALL cp_print_key_finished_output(unit_nr=unit_nr, &
1918 logger=logger, &
1919 basis_section=input, &
1920 print_key_path="DFT%PRINT%XRAY_DIFFRACTION_SPECTRUM")
1921 END IF
1922
1923 CALL timestop(handle)
1924
1925 END SUBROUTINE qs_scf_post_xray
1926
1927! **************************************************************************************************
1928!> \brief Computes and prints Electric Field Gradient
1929!> \param input ...
1930!> \param logger ...
1931!> \param qs_env the qs_env in which the qs_env lives
1932! **************************************************************************************************
1933 SUBROUTINE qs_scf_post_efg(input, logger, qs_env)
1934 TYPE(section_vals_type), POINTER :: input
1935 TYPE(cp_logger_type), POINTER :: logger
1936 TYPE(qs_environment_type), POINTER :: qs_env
1937
1938 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_efg'
1939
1940 INTEGER :: handle
1941 TYPE(section_vals_type), POINTER :: print_key
1942
1943 CALL timeset(routinen, handle)
1944
1945 print_key => section_vals_get_subs_vals(section_vals=input, &
1946 subsection_name="DFT%PRINT%ELECTRIC_FIELD_GRADIENT")
1947 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), &
1948 cp_p_file)) THEN
1949 CALL qs_efg_calc(qs_env=qs_env)
1950 END IF
1951
1952 CALL timestop(handle)
1953
1954 END SUBROUTINE qs_scf_post_efg
1955
1956! **************************************************************************************************
1957!> \brief Computes the Electron Transfer Coupling matrix element
1958!> \param input ...
1959!> \param qs_env the qs_env in which the qs_env lives
1960!> \param dft_control ...
1961! **************************************************************************************************
1962 SUBROUTINE qs_scf_post_et(input, qs_env, dft_control)
1963 TYPE(section_vals_type), POINTER :: input
1964 TYPE(qs_environment_type), POINTER :: qs_env
1965 TYPE(dft_control_type), POINTER :: dft_control
1966
1967 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_et'
1968
1969 INTEGER :: handle, ispin
1970 LOGICAL :: do_et
1971 TYPE(cp_fm_type), DIMENSION(:), POINTER :: my_mos
1972 TYPE(section_vals_type), POINTER :: et_section
1973
1974 CALL timeset(routinen, handle)
1975
1976 do_et = .false.
1977 et_section => section_vals_get_subs_vals(input, "PROPERTIES%ET_COUPLING")
1978 CALL section_vals_get(et_section, explicit=do_et)
1979 IF (do_et) THEN
1980 IF (qs_env%et_coupling%first_run) THEN
1981 NULLIFY (my_mos)
1982 ALLOCATE (my_mos(dft_control%nspins))
1983 ALLOCATE (qs_env%et_coupling%et_mo_coeff(dft_control%nspins))
1984 DO ispin = 1, dft_control%nspins
1985 CALL cp_fm_create(matrix=my_mos(ispin), &
1986 matrix_struct=qs_env%mos(ispin)%mo_coeff%matrix_struct, &
1987 name="FIRST_RUN_COEFF"//trim(adjustl(cp_to_string(ispin)))//"MATRIX")
1988 CALL cp_fm_to_fm(qs_env%mos(ispin)%mo_coeff, &
1989 my_mos(ispin))
1990 END DO
1991 CALL set_et_coupling_type(qs_env%et_coupling, et_mo_coeff=my_mos)
1992 DEALLOCATE (my_mos)
1993 END IF
1994 END IF
1995
1996 CALL timestop(handle)
1997
1998 END SUBROUTINE qs_scf_post_et
1999
2000! **************************************************************************************************
2001!> \brief compute the electron localization function
2002!>
2003!> \param input ...
2004!> \param logger ...
2005!> \param qs_env ...
2006!> \par History
2007!> 2012-07 Created [MI]
2008! **************************************************************************************************
2009 SUBROUTINE qs_scf_post_elf(input, logger, qs_env)
2010 TYPE(section_vals_type), POINTER :: input
2011 TYPE(cp_logger_type), POINTER :: logger
2012 TYPE(qs_environment_type), POINTER :: qs_env
2013
2014 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_elf'
2015
2016 CHARACTER(LEN=default_path_length) :: filename, mpi_filename, my_pos_cube, &
2017 title
2018 INTEGER :: handle, ispin, output_unit, unit_nr
2019 LOGICAL :: append_cube, gapw, mpi_io
2020 REAL(dp) :: rho_cutoff
2021 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: zcharge
2022 TYPE(cp_section_key) :: elf_section_key
2023 TYPE(dft_control_type), POINTER :: dft_control
2024 TYPE(particle_list_type), POINTER :: particles
2025 TYPE(pw_env_type), POINTER :: pw_env
2026 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
2027 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
2028 TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: elf_r
2029 TYPE(qs_subsys_type), POINTER :: subsys
2030 TYPE(section_vals_type), POINTER :: elf_section
2031
2032 CALL timeset(routinen, handle)
2033 output_unit = cp_logger_get_default_io_unit(logger)
2034
2035 elf_section_key = cube_or_openpmd(input, str_elf_cubes, str_elf_openpmd, logger)
2036
2037 elf_section => section_vals_get_subs_vals(input, elf_section_key%absolute_section_key)
2038 IF (elf_section_key%do_output) THEN
2039
2040 NULLIFY (dft_control, pw_env, auxbas_pw_pool, pw_pools, particles, subsys)
2041 CALL get_qs_env(qs_env, dft_control=dft_control, pw_env=pw_env, subsys=subsys)
2042 CALL qs_subsys_get(subsys, particles=particles)
2043
2044 gapw = dft_control%qs_control%gapw
2045 IF (.NOT. gapw) THEN
2046 ! allocate
2047 ALLOCATE (elf_r(dft_control%nspins))
2048 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
2049 pw_pools=pw_pools)
2050 DO ispin = 1, dft_control%nspins
2051 CALL auxbas_pw_pool%create_pw(elf_r(ispin))
2052 CALL pw_zero(elf_r(ispin))
2053 END DO
2054
2055 IF (output_unit > 0) THEN
2056 WRITE (unit=output_unit, fmt="(/,T15,A,/)") &
2057 " ----- ELF is computed on the real space grid -----"
2058 END IF
2059 rho_cutoff = section_get_rval(elf_section, "density_cutoff")
2060 CALL qs_elf_calc(qs_env, elf_r, rho_cutoff)
2061 CALL get_effective_core_charges(qs_env, zcharge)
2062
2063 ! write ELF into cube file
2064
2065 ! For openPMD, refer to access modes instead of APPEND key
2066 IF (elf_section_key%grid_output == grid_output_cubes) THEN
2067 append_cube = section_get_lval(elf_section, "APPEND")
2068 END IF
2069 my_pos_cube = "REWIND"
2070 IF (append_cube) THEN
2071 my_pos_cube = "APPEND"
2072 END IF
2073
2074 DO ispin = 1, dft_control%nspins
2075 WRITE (filename, '(a5,I1.1)') "ELF_S", ispin
2076 WRITE (title, *) "ELF spin ", ispin
2077 mpi_io = .true.
2078 unit_nr = elf_section_key%print_key_unit_nr( &
2079 logger, &
2080 input, &
2081 elf_section_key%absolute_section_key, &
2082 extension=".cube", &
2083 middle_name=trim(filename), &
2084 file_position=my_pos_cube, &
2085 log_filename=.false., &
2086 mpi_io=mpi_io, &
2087 fout=mpi_filename, &
2088 openpmd_basename="dft-elf", &
2089 openpmd_unit_dimension=openpmd_unit_dimension_dimensionless, &
2090 openpmd_unit_si=openpmd_unit_si_dimensionless, &
2091 sim_time=qs_env%sim_time)
2092 IF (output_unit > 0) THEN
2093 IF (.NOT. mpi_io) THEN
2094 INQUIRE (unit=unit_nr, name=filename)
2095 ELSE
2096 filename = mpi_filename
2097 END IF
2098 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2099 "ELF is written in "//elf_section_key%format_name//" file format to the file:", &
2100 trim(filename)
2101 END IF
2102
2103 CALL elf_section_key%write_pw(elf_r(ispin), unit_nr, title, particles=particles, zeff=zcharge, &
2104 stride=section_get_ivals(elf_section, "STRIDE"), mpi_io=mpi_io)
2105 CALL elf_section_key%print_key_finished_output( &
2106 unit_nr, &
2107 logger, &
2108 input, &
2109 elf_section_key%absolute_section_key, &
2110 mpi_io=mpi_io)
2111
2112 CALL auxbas_pw_pool%give_back_pw(elf_r(ispin))
2113 END DO
2114
2115 ! deallocate
2116 DEALLOCATE (elf_r, zcharge)
2117
2118 ELSE
2119 ! not implemented
2120 cpwarn("ELF not implemented for GAPW calculations!")
2121 END IF
2122
2123 END IF ! print key
2124
2125 CALL timestop(handle)
2126
2127 END SUBROUTINE qs_scf_post_elf
2128
2129! **************************************************************************************************
2130!> \brief computes the condition number of the overlap matrix and
2131!> prints the value of the total energy. This is needed
2132!> for BASIS_MOLOPT optimizations
2133!> \param input ...
2134!> \param logger ...
2135!> \param qs_env the qs_env in which the qs_env lives
2136!> \par History
2137!> 2007-07 Created [Joost VandeVondele]
2138! **************************************************************************************************
2139 SUBROUTINE qs_scf_post_molopt(input, logger, qs_env)
2140 TYPE(section_vals_type), POINTER :: input
2141 TYPE(cp_logger_type), POINTER :: logger
2142 TYPE(qs_environment_type), POINTER :: qs_env
2143
2144 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_molopt'
2145
2146 INTEGER :: handle, nao, unit_nr
2147 REAL(kind=dp) :: s_cond_number
2148 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues
2149 TYPE(cp_fm_struct_type), POINTER :: ao_ao_fmstruct
2150 TYPE(cp_fm_type) :: fm_s, fm_work
2151 TYPE(cp_fm_type), POINTER :: mo_coeff
2152 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
2153 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
2154 TYPE(qs_energy_type), POINTER :: energy
2155 TYPE(section_vals_type), POINTER :: print_key
2156
2157 CALL timeset(routinen, handle)
2158
2159 print_key => section_vals_get_subs_vals(section_vals=input, &
2160 subsection_name="DFT%PRINT%BASIS_MOLOPT_QUANTITIES")
2161 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), &
2162 cp_p_file)) THEN
2163
2164 CALL get_qs_env(qs_env, energy=energy, matrix_s=matrix_s, mos=mos)
2165
2166 ! set up the two needed full matrices, using mo_coeff as a template
2167 CALL get_mo_set(mo_set=mos(1), mo_coeff=mo_coeff, nao=nao)
2168 CALL cp_fm_struct_create(fmstruct=ao_ao_fmstruct, &
2169 nrow_global=nao, ncol_global=nao, &
2170 template_fmstruct=mo_coeff%matrix_struct)
2171 CALL cp_fm_create(fm_s, matrix_struct=ao_ao_fmstruct, &
2172 name="fm_s")
2173 CALL cp_fm_create(fm_work, matrix_struct=ao_ao_fmstruct, &
2174 name="fm_work")
2175 CALL cp_fm_struct_release(ao_ao_fmstruct)
2176 ALLOCATE (eigenvalues(nao))
2177
2178 CALL copy_dbcsr_to_fm(matrix_s(1)%matrix, fm_s)
2179 CALL choose_eigv_solver(fm_s, fm_work, eigenvalues)
2180
2181 CALL cp_fm_release(fm_s)
2182 CALL cp_fm_release(fm_work)
2183
2184 s_cond_number = maxval(abs(eigenvalues))/max(minval(abs(eigenvalues)), epsilon(0.0_dp))
2185
2186 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%BASIS_MOLOPT_QUANTITIES", &
2187 extension=".molopt")
2188
2189 IF (unit_nr > 0) THEN
2190 ! please keep this format fixed, needs to be grepable for molopt
2191 ! optimizations
2192 WRITE (unit_nr, '(T2,A28,2A25)') "", "Tot. Ener.", "S Cond. Numb."
2193 WRITE (unit_nr, '(T2,A28,2E25.17)') "BASIS_MOLOPT_QUANTITIES", energy%total, s_cond_number
2194 END IF
2195
2196 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2197 "DFT%PRINT%BASIS_MOLOPT_QUANTITIES")
2198
2199 END IF
2200
2201 CALL timestop(handle)
2202
2203 END SUBROUTINE qs_scf_post_molopt
2204
2205! **************************************************************************************************
2206!> \brief Dumps EPR
2207!> \param input ...
2208!> \param logger ...
2209!> \param qs_env the qs_env in which the qs_env lives
2210! **************************************************************************************************
2211 SUBROUTINE qs_scf_post_epr(input, logger, qs_env)
2212 TYPE(section_vals_type), POINTER :: input
2213 TYPE(cp_logger_type), POINTER :: logger
2214 TYPE(qs_environment_type), POINTER :: qs_env
2215
2216 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_epr'
2217
2218 INTEGER :: handle
2219 TYPE(section_vals_type), POINTER :: print_key
2220
2221 CALL timeset(routinen, handle)
2222
2223 print_key => section_vals_get_subs_vals(section_vals=input, &
2224 subsection_name="DFT%PRINT%HYPERFINE_COUPLING_TENSOR")
2225 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), &
2226 cp_p_file)) THEN
2227 CALL qs_epr_hyp_calc(qs_env=qs_env)
2228 END IF
2229
2230 CALL timestop(handle)
2231
2232 END SUBROUTINE qs_scf_post_epr
2233
2234! **************************************************************************************************
2235!> \brief Interface routine to trigger writing of results available from normal
2236!> SCF. Can write MO-dependent and MO free results (needed for call from
2237!> the linear scaling code)
2238!> \param qs_env the qs_env in which the qs_env lives
2239!> \param scf_env ...
2240! **************************************************************************************************
2241 SUBROUTINE write_available_results(qs_env, scf_env)
2242 TYPE(qs_environment_type), POINTER :: qs_env
2243 TYPE(qs_scf_env_type), OPTIONAL, POINTER :: scf_env
2244
2245 CHARACTER(len=*), PARAMETER :: routinen = 'write_available_results'
2246
2247 INTEGER :: handle
2248
2249 CALL timeset(routinen, handle)
2250
2251 ! those properties that require MOs (not suitable density matrix based methods)
2252 CALL write_mo_dependent_results(qs_env, scf_env)
2253
2254 ! those that depend only on the density matrix, they should be linear scaling in their implementation
2255 CALL write_mo_free_results(qs_env)
2256
2257 CALL timestop(handle)
2258
2259 END SUBROUTINE write_available_results
2260
2261! **************************************************************************************************
2262!> \brief Write QS results available if MO's are present (if switched on through the print_keys)
2263!> Writes only MO dependent results. Split is necessary as ls_scf does not
2264!> provide MO's
2265!> \param qs_env the qs_env in which the qs_env lives
2266!> \param scf_env ...
2267! **************************************************************************************************
2268 SUBROUTINE write_mo_dependent_results(qs_env, scf_env)
2269 TYPE(qs_environment_type), POINTER :: qs_env
2270 TYPE(qs_scf_env_type), OPTIONAL, POINTER :: scf_env
2271
2272 CHARACTER(len=*), PARAMETER :: routinen = 'write_mo_dependent_results'
2273
2274 INTEGER :: handle, homo, ispin, nlumo_dos, &
2275 nlumo_molden, nlumo_required, nlumos, &
2276 nmo, output_unit
2277 LOGICAL :: all_equal, defer_molden, do_curve, &
2278 do_dos, do_kpoints, do_pdos, &
2279 do_projected_dos, explicit
2280 REAL(kind=dp) :: maxocc, s_square, s_square_ideal, &
2281 total_abs_spin_dens, total_spin_dens
2282 REAL(kind=dp), DIMENSION(:), POINTER :: mo_eigenvalues, occupation_numbers
2283 TYPE(admm_type), POINTER :: admm_env
2284 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
2285 TYPE(cell_type), POINTER :: cell
2286 TYPE(cp_1d_r_p_type), DIMENSION(:), POINTER :: unoccupied_evals
2287 TYPE(cp_fm_type), DIMENSION(:), POINTER :: unoccupied_orbs
2288 TYPE(cp_fm_type), POINTER :: mo_coeff
2289 TYPE(cp_logger_type), POINTER :: logger
2290 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_rmpv, matrix_s
2291 TYPE(dbcsr_type), POINTER :: mo_coeff_deriv
2292 TYPE(dft_control_type), POINTER :: dft_control
2293 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
2294 TYPE(molecule_type), POINTER :: molecule_set(:)
2295 TYPE(particle_list_type), POINTER :: particles
2296 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
2297 TYPE(pw_env_type), POINTER :: pw_env
2298 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
2299 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
2300 TYPE(pw_r3d_rs_type) :: wf_r
2301 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
2302 TYPE(qs_charges_type), POINTER :: qs_charges
2303 TYPE(qs_energy_type), POINTER :: energy
2304 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
2305 TYPE(qs_rho_type), POINTER :: rho
2306 TYPE(qs_subsys_type), POINTER :: subsys
2307 TYPE(scf_control_type), POINTER :: scf_control
2308 TYPE(section_vals_type), POINTER :: casino_section, dft_section, &
2309 dos_section, input, sprint_section, &
2310 trexio_section
2311
2312! TYPE(kpoint_type), POINTER :: kpoints
2313
2314 CALL timeset(routinen, handle)
2315
2316 NULLIFY (cell, dft_control, pw_env, auxbas_pw_pool, pw_pools, mo_coeff, &
2317 mo_coeff_deriv, mo_eigenvalues, mos, atomic_kind_set, qs_kind_set, &
2318 particle_set, rho, ks_rmpv, matrix_s, scf_control, dft_section, &
2319 molecule_set, input, particles, subsys, rho_r, unoccupied_orbs, &
2320 unoccupied_evals, casino_section, dos_section)
2321
2322 logger => cp_get_default_logger()
2323 output_unit = cp_logger_get_default_io_unit(logger)
2324
2325 cpassert(ASSOCIATED(qs_env))
2326 CALL get_qs_env(qs_env, &
2327 dft_control=dft_control, &
2328 molecule_set=molecule_set, &
2329 atomic_kind_set=atomic_kind_set, &
2330 particle_set=particle_set, &
2331 qs_kind_set=qs_kind_set, &
2332 admm_env=admm_env, &
2333 scf_control=scf_control, &
2334 input=input, &
2335 cell=cell, &
2336 subsys=subsys)
2337 CALL qs_subsys_get(subsys, particles=particles)
2338 CALL get_qs_env(qs_env, rho=rho)
2339 CALL qs_rho_get(rho, rho_r=rho_r)
2340
2341 ! k points
2342 CALL get_qs_env(qs_env, do_kpoints=do_kpoints)
2343
2344 ! Write last MO information to output file if requested
2345 dft_section => section_vals_get_subs_vals(input, "DFT")
2346 IF (.NOT. qs_env%run_rtp) THEN
2347 CALL qs_scf_write_mos(qs_env, scf_env, final_mos=.true.)
2348 trexio_section => section_vals_get_subs_vals(dft_section, "PRINT%TREXIO")
2349 CALL section_vals_get(trexio_section, explicit=explicit)
2350 IF (explicit) THEN
2351 CALL write_trexio(qs_env, trexio_section)
2352 END IF
2353 casino_section => section_vals_get_subs_vals(dft_section, "PRINT%CASINO")
2354 CALL section_vals_get(casino_section, explicit=explicit)
2355 IF (explicit) THEN
2356 CALL write_casino(qs_env, casino_section)
2357 END IF
2358 sprint_section => section_vals_get_subs_vals(dft_section, "PRINT%MO_MOLDEN")
2359 defer_molden = .false.
2360 IF (.NOT. do_kpoints) THEN
2361 CALL get_qs_env(qs_env, mos=mos, matrix_ks=ks_rmpv)
2362 CALL write_dm_binary_restart(mos, dft_section, ks_rmpv)
2363 ! Check if molden write should be deferred for OT unoccupied orbitals
2364 CALL section_vals_val_get(sprint_section, "NLUMO", i_val=nlumo_molden)
2365 IF (nlumo_molden /= 0 .AND. PRESENT(scf_env)) THEN
2366 IF (scf_env%method == ot_method_nr) defer_molden = .true.
2367 END IF
2368 IF (.NOT. defer_molden) THEN
2369 CALL write_mos_molden(mos, qs_kind_set, particle_set, sprint_section, cell=cell, &
2370 qs_env=qs_env, calc_energies=.true.)
2371 END IF
2372 ! Write Chargemol .wfx
2373 IF (btest(cp_print_key_should_output(logger%iter_info, dft_section, "PRINT%CHARGEMOL"), &
2374 cp_p_file)) THEN
2375 CALL write_wfx(qs_env, dft_section)
2376 END IF
2377 ELSE
2378 IF (btest(cp_print_key_should_output(logger%iter_info, sprint_section, ""), cp_p_file)) THEN
2379 cpwarn("Molden format output is not possible for k-point calculations.")
2380 END IF
2381 IF (btest(cp_print_key_should_output(logger%iter_info, dft_section, "PRINT%CHARGEMOL"), &
2382 cp_p_file)) THEN
2383 cpwarn("Chargemol .wfx format output is not possible for k-point calculations.")
2384 END IF
2385 END IF
2386
2387 ! K-point MO wavefunction dump
2388 IF (btest(cp_print_key_should_output(logger%iter_info, dft_section, "PRINT%MO_KP"), &
2389 cp_p_file)) THEN
2390 IF (do_kpoints) THEN
2391 CALL write_kpoint_mo_data(qs_env, &
2392 section_vals_get_subs_vals(input, "DFT%PRINT%MO_KP"))
2393 ELSE
2394 cpwarn("MO_KP is only available for k-point calculations, ignored for Gamma-only")
2395 END IF
2396 END IF
2397
2398 dos_section => section_vals_get_subs_vals(dft_section, "PRINT%DOS")
2399 do_dos = btest(cp_print_key_should_output(logger%iter_info, dos_section), cp_p_file)
2400 CALL get_dos_pdos_flags(dos_section, do_dos, do_projected_dos, do_pdos, do_curve)
2401
2402 ! For OT calculations, collect the largest request for additional unoccupied
2403 ! orbitals among DOS, PDOS, and Molden, and generate them only once.
2404 nlumo_required = 0
2405 IF (.NOT. do_kpoints .AND. PRESENT(scf_env)) THEN
2406 IF (scf_env%method == ot_method_nr) THEN
2407 IF (do_dos) THEN
2408 CALL section_vals_val_get(dft_section, "PRINT%DOS%NLUMO", i_val=nlumo_dos)
2409 IF (nlumo_dos == -1) THEN
2410 nlumo_required = -1
2411 ELSE IF (nlumo_required /= -1) THEN
2412 nlumo_required = max(nlumo_required, nlumo_dos)
2413 END IF
2414 END IF
2415
2416 IF (defer_molden) THEN
2417 IF (nlumo_molden == -1) THEN
2418 nlumo_required = -1
2419 ELSE IF (nlumo_required /= -1) THEN
2420 nlumo_required = max(nlumo_required, nlumo_molden)
2421 END IF
2422 END IF
2423 IF (nlumo_required /= 0) THEN
2424 ALLOCATE (unoccupied_orbs(dft_control%nspins))
2425 ALLOCATE (unoccupied_evals(dft_control%nspins))
2426 CALL make_lumo_gpw(qs_env, scf_env, unoccupied_orbs, unoccupied_evals, &
2427 nlumo_required, nlumos)
2428 END IF
2429
2430 IF (do_dos .OR. do_projected_dos) THEN
2431 DO ispin = 1, dft_control%nspins
2432 ! With ADMM, temporarily modify the Kohn-Sham matrix while updating the
2433 ! eigenvalues and rotating the occupied OT subspace.
2434 IF (dft_control%do_admm) THEN
2435 CALL admm_correct_for_eigenvalues(ispin, admm_env, ks_rmpv(ispin)%matrix)
2436 END IF
2437 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, &
2438 eigenvalues=mo_eigenvalues)
2439 IF (ASSOCIATED(qs_env%mo_derivs)) THEN
2440 mo_coeff_deriv => qs_env%mo_derivs(ispin)%matrix
2441 ELSE
2442 mo_coeff_deriv => null()
2443 END IF
2444 CALL calculate_subspace_eigenvalues(mo_coeff, ks_rmpv(ispin)%matrix, mo_eigenvalues, &
2445 do_rotation=.true., &
2446 co_rotate_dbcsr=mo_coeff_deriv)
2447 CALL set_mo_occupation(mo_set=mos(ispin))
2448 IF (dft_control%do_admm) THEN
2449 CALL admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_rmpv(ispin)%matrix)
2450 END IF
2451 END DO
2452 END IF
2453 END IF
2454 END IF
2455
2456 IF (defer_molden) THEN
2457 IF (ASSOCIATED(unoccupied_orbs)) THEN
2458 IF (output_unit > 0) THEN
2459 WRITE (output_unit, '(/,T2,A,I6,A)') &
2460 "MO_MOLDEN| Writing ", nlumos, " unoccupied orbitals to molden file"
2461 END IF
2462 CALL write_mos_molden(mos, qs_kind_set, particle_set, sprint_section, cell=cell, &
2463 unoccupied_orbs=unoccupied_orbs, &
2464 unoccupied_evals=unoccupied_evals, &
2465 qs_env=qs_env, calc_energies=.true.)
2466 END IF
2467 END IF
2468
2469 ! DOS printout after the SCF cycle is completed
2470 IF (do_dos) THEN
2471 IF (do_kpoints) THEN
2472 CALL calculate_dos_kp(qs_env, dft_section)
2473 IF (do_curve) CALL calculate_dos_kp(qs_env, dft_section, write_curve_output=.true.)
2474 ELSE
2475 CALL get_qs_env(qs_env, mos=mos)
2476 IF (ASSOCIATED(unoccupied_evals)) THEN
2477 CALL calculate_dos(mos, dft_section, unoccupied_evals=unoccupied_evals, &
2478 smearing_enabled=dft_control%smear)
2479 IF (do_curve) CALL calculate_dos(mos, dft_section, unoccupied_evals=unoccupied_evals, &
2480 smearing_enabled=dft_control%smear, write_curve_output=.true.)
2481 ELSE
2482 CALL calculate_dos(mos, dft_section, smearing_enabled=dft_control%smear)
2483 IF (do_curve) CALL calculate_dos(mos, dft_section, smearing_enabled=dft_control%smear, &
2484 write_curve_output=.true.)
2485 END IF
2486 END IF
2487 END IF
2488
2489 ! Print projected density-of-states outputs
2490 IF (do_projected_dos) THEN
2491 IF (do_kpoints) THEN
2492 CALL calculate_projected_dos_kp(qs_env, dft_section, pdos_print_key="PRINT%DOS", &
2493 write_pdos=do_pdos, write_pdos_curve=do_curve)
2494 ELSE
2495 CALL get_qs_env(qs_env, &
2496 mos=mos, &
2497 matrix_ks=ks_rmpv)
2498 DO ispin = 1, dft_control%nspins
2499 IF (dft_control%nspins == 2) THEN
2500 IF (ASSOCIATED(unoccupied_orbs)) THEN
2501 CALL calculate_projected_dos(mos(ispin), atomic_kind_set, &
2502 qs_kind_set, particle_set, qs_env, dft_section, ispin=ispin, &
2503 unoccupied_orbs=unoccupied_orbs(ispin), &
2504 unoccupied_evals=unoccupied_evals(ispin), &
2505 pdos_print_key="PRINT%DOS", write_pdos=do_pdos, write_pdos_curve=do_curve)
2506 ELSE
2507 CALL calculate_projected_dos(mos(ispin), atomic_kind_set, &
2508 qs_kind_set, particle_set, qs_env, dft_section, ispin=ispin, &
2509 pdos_print_key="PRINT%DOS", write_pdos=do_pdos, write_pdos_curve=do_curve)
2510 END IF
2511 ELSE
2512 IF (ASSOCIATED(unoccupied_orbs)) THEN
2513 CALL calculate_projected_dos(mos(ispin), atomic_kind_set, &
2514 qs_kind_set, particle_set, qs_env, dft_section, &
2515 unoccupied_orbs=unoccupied_orbs(ispin), &
2516 unoccupied_evals=unoccupied_evals(ispin), &
2517 pdos_print_key="PRINT%DOS", write_pdos=do_pdos, write_pdos_curve=do_curve)
2518 ELSE
2519 CALL calculate_projected_dos(mos(ispin), atomic_kind_set, &
2520 qs_kind_set, particle_set, qs_env, dft_section, &
2521 pdos_print_key="PRINT%DOS", write_pdos=do_pdos, write_pdos_curve=do_curve)
2522 END IF
2523 END IF
2524 END DO
2525 END IF
2526 END IF
2527 IF (ASSOCIATED(unoccupied_orbs)) THEN
2528 DO ispin = 1, dft_control%nspins
2529 DEALLOCATE (unoccupied_evals(ispin)%array)
2530 CALL cp_fm_release(unoccupied_orbs(ispin))
2531 END DO
2532 DEALLOCATE (unoccupied_evals)
2533 DEALLOCATE (unoccupied_orbs)
2534 END IF
2535 END IF
2536
2537 ! Integrated absolute spin density and spin contamination ***
2538 IF (dft_control%nspins == 2) THEN
2539 total_spin_dens = 0.0_dp
2540 total_abs_spin_dens = 0.0_dp
2541 IF (dft_control%qs_control%gapw) THEN
2542 CALL get_qs_env(qs_env, qs_charges=qs_charges)
2543 total_spin_dens = qs_charges%total_rho_hard_spin - &
2544 qs_charges%total_rho_soft_spin
2545 total_abs_spin_dens = qs_charges%total_rho_hard_abs_spin - &
2546 qs_charges%total_rho_soft_abs_spin
2547 END IF
2548 CALL get_qs_env(qs_env, mos=mos)
2549 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
2550 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
2551 pw_pools=pw_pools)
2552 CALL auxbas_pw_pool%create_pw(wf_r)
2553 CALL pw_copy(rho_r(1), wf_r)
2554 CALL pw_axpy(rho_r(2), wf_r, alpha=-1._dp)
2555 total_spin_dens = total_spin_dens + pw_integrate_function(wf_r)
2556 IF (output_unit > 0) WRITE (unit=output_unit, fmt='(/,(T3,A,T61,F20.10))') &
2557 "Integrated spin density: ", total_spin_dens
2558 total_abs_spin_dens = total_abs_spin_dens + pw_integrate_function(wf_r, oprt="ABS")
2559 IF (output_unit > 0) WRITE (unit=output_unit, fmt='((T3,A,T61,F20.10))') &
2560 "Integrated absolute spin density: ", total_abs_spin_dens
2561 CALL auxbas_pw_pool%give_back_pw(wf_r)
2562 !
2563 ! XXX Fix Me XXX
2564 ! should be extended to the case where added MOs are present
2565 ! should be extended to the k-point case
2566 !
2567 IF (.NOT. do_kpoints) THEN
2568 all_equal = .true.
2569 DO ispin = 1, dft_control%nspins
2570 CALL get_mo_set(mo_set=mos(ispin), &
2571 occupation_numbers=occupation_numbers, &
2572 homo=homo, &
2573 nmo=nmo, &
2574 maxocc=maxocc)
2575 IF (nmo > 0) THEN
2576 all_equal = all_equal .AND. &
2577 (all(occupation_numbers(1:homo) == maxocc) .AND. &
2578 all(occupation_numbers(homo + 1:nmo) == 0.0_dp))
2579 END IF
2580 END DO
2581 IF (all_equal) THEN
2582 CALL get_qs_env(qs_env=qs_env, &
2583 matrix_s=matrix_s, &
2584 energy=energy)
2585 CALL compute_s_square(mos=mos, matrix_s=matrix_s, s_square=s_square, &
2586 s_square_ideal=s_square_ideal)
2587 IF (output_unit > 0) WRITE (unit=output_unit, fmt='(T3,A,T51,2F15.6)') &
2588 "Ideal and single determinant S**2 : ", s_square_ideal, s_square
2589 energy%s_square = s_square
2590 END IF
2591 END IF
2592 END IF
2593
2594 CALL timestop(handle)
2595
2596 END SUBROUTINE write_mo_dependent_results
2597
2598! **************************************************************************************************
2599!> \brief Write QS results always available (if switched on through the print_keys)
2600!> Can be called from ls_scf
2601!> \param qs_env the qs_env in which the qs_env lives
2602! **************************************************************************************************
2603 SUBROUTINE write_mo_free_results(qs_env)
2604 TYPE(qs_environment_type), POINTER :: qs_env
2605
2606 CHARACTER(len=*), PARAMETER :: routinen = 'write_mo_free_results'
2607 CHARACTER(len=1), DIMENSION(3), PARAMETER :: cdir = ["x", "y", "z"]
2608
2609 CHARACTER(LEN=2) :: element_symbol
2610 CHARACTER(LEN=default_path_length) :: filename, mpi_filename, my_pos_cube, &
2611 my_pos_voro
2612 CHARACTER(LEN=default_string_length) :: name, print_density
2613 INTEGER :: after, handle, i, iat, id, ikind, img, iso, ispin, iw, l, n_rep_hf, natom, nd(3), &
2614 ngto, niso, nkind, np, nr, output_unit, print_level, should_print_bqb, should_print_voro, &
2615 unit_nr, unit_nr_voro
2616 LOGICAL :: append_cube, append_voro, do_hfx, do_kpoints, mpi_io, omit_headers, print_it, &
2617 rho_r_valid, voro_print_txt, write_ks, write_xc, xrd_interface
2618 REAL(kind=dp) :: norm_factor, q_max, rho_hard, rho_soft, &
2619 rho_total, rho_total_rspace, udvol, &
2620 volume
2621 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: zcharge
2622 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: bfun
2623 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :, :) :: aedens, ccdens, ppdens
2624 REAL(kind=dp), DIMENSION(3) :: checksum_hr, dr
2625 REAL(kind=dp), DIMENSION(:), POINTER :: my_q0
2626 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
2627 TYPE(atomic_kind_type), POINTER :: atomic_kind
2628 TYPE(cell_type), POINTER :: cell
2629 TYPE(cp_logger_type), POINTER :: logger
2630 TYPE(cp_section_key) :: e_density_section
2631 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_hr
2632 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: ks_rmpv, matrix_s, matrix_vxc, rho_ao
2633 TYPE(dft_control_type), POINTER :: dft_control
2634 TYPE(grid_atom_type), POINTER :: grid_atom
2635 TYPE(iao_env_type) :: iao_env
2636 TYPE(mp_para_env_type), POINTER :: para_env
2637 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
2638 POINTER :: sab_orb, sap_ppnl
2639 TYPE(particle_list_type), POINTER :: particles
2640 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
2641 TYPE(pw_c1d_gs_type) :: aux_g, rho_elec_gspace
2642 TYPE(pw_c1d_gs_type), POINTER :: rho0_s_gs, rho_core, rhoz_cneo_s_gs
2643 TYPE(pw_env_type), POINTER :: pw_env
2644 TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools
2645 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
2646 TYPE(pw_r3d_rs_type) :: aux_r, rho_elec_rspace, wf_r
2647 TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER :: rho_r
2648 TYPE(pw_r3d_rs_type), POINTER :: mb_rho, v_hartree_rspace, vee
2649 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
2650 TYPE(qs_kind_type), POINTER :: qs_kind
2651 TYPE(qs_rho_type), POINTER :: rho
2652 TYPE(qs_subsys_type), POINTER :: subsys
2653 TYPE(rho0_mpole_type), POINTER :: rho0_mpole
2654 TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set
2655 TYPE(rho_atom_type), POINTER :: rho_atom
2656 TYPE(section_vals_type), POINTER :: dft_section, hfx_section, input, &
2657 print_key, print_key_bqb, &
2658 print_key_voro, xc_section
2659
2660 CALL timeset(routinen, handle)
2661 NULLIFY (cell, dft_control, pw_env, auxbas_pw_pool, pw_pools, hfx_section, &
2662 atomic_kind_set, qs_kind_set, particle_set, rho, ks_rmpv, rho_ao, rho_r, &
2663 dft_section, xc_section, input, particles, subsys, matrix_vxc, v_hartree_rspace, &
2664 vee, matrix_hr, matrix_s, sab_orb, sap_ppnl)
2665
2666 logger => cp_get_default_logger()
2667 output_unit = cp_logger_get_default_io_unit(logger)
2668
2669 cpassert(ASSOCIATED(qs_env))
2670 CALL get_qs_env(qs_env, &
2671 atomic_kind_set=atomic_kind_set, &
2672 qs_kind_set=qs_kind_set, &
2673 nkind=nkind, &
2674 natom=natom, &
2675 particle_set=particle_set, &
2676 cell=cell, &
2677 para_env=para_env, &
2678 dft_control=dft_control, &
2679 input=input, &
2680 do_kpoints=do_kpoints, &
2681 subsys=subsys, &
2682 matrix_s_kp=matrix_s, &
2683 sab_orb=sab_orb, &
2684 sap_ppnl=sap_ppnl)
2685 dft_section => section_vals_get_subs_vals(input, "DFT")
2686 CALL qs_subsys_get(subsys, particles=particles)
2687
2688 CALL get_qs_env(qs_env, rho=rho)
2689 CALL qs_rho_get(rho, rho_r=rho_r)
2690
2691 CALL get_effective_core_charges(qs_env, zcharge)
2692
2693 ! Print the total density (electronic + core charge)
2694 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
2695 "DFT%PRINT%TOT_DENSITY_CUBE"), cp_p_file)) THEN
2696 NULLIFY (rho_core, rho0_s_gs, rhoz_cneo_s_gs)
2697 append_cube = section_get_lval(input, "DFT%PRINT%TOT_DENSITY_CUBE%APPEND")
2698 my_pos_cube = "REWIND"
2699 IF (append_cube) THEN
2700 my_pos_cube = "APPEND"
2701 END IF
2702
2703 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, rho_core=rho_core, &
2704 rho0_s_gs=rho0_s_gs, rhoz_cneo_s_gs=rhoz_cneo_s_gs)
2705 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
2706 pw_pools=pw_pools)
2707 CALL auxbas_pw_pool%create_pw(wf_r)
2708 IF (dft_control%qs_control%gapw) THEN
2709 IF (dft_control%qs_control%gapw_control%nopaw_as_gpw) THEN
2710 CALL pw_axpy(rho_core, rho0_s_gs)
2711 IF (ASSOCIATED(rhoz_cneo_s_gs)) THEN
2712 CALL pw_axpy(rhoz_cneo_s_gs, rho0_s_gs)
2713 END IF
2714 CALL pw_transfer(rho0_s_gs, wf_r)
2715 CALL pw_axpy(rho_core, rho0_s_gs, -1.0_dp)
2716 IF (ASSOCIATED(rhoz_cneo_s_gs)) THEN
2717 CALL pw_axpy(rhoz_cneo_s_gs, rho0_s_gs, -1.0_dp)
2718 END IF
2719 ELSE
2720 IF (ASSOCIATED(rhoz_cneo_s_gs)) THEN
2721 CALL pw_axpy(rhoz_cneo_s_gs, rho0_s_gs)
2722 END IF
2723 CALL pw_transfer(rho0_s_gs, wf_r)
2724 IF (ASSOCIATED(rhoz_cneo_s_gs)) THEN
2725 CALL pw_axpy(rhoz_cneo_s_gs, rho0_s_gs, -1.0_dp)
2726 END IF
2727 END IF
2728 ELSE
2729 CALL pw_transfer(rho_core, wf_r)
2730 END IF
2731 DO ispin = 1, dft_control%nspins
2732 CALL pw_axpy(rho_r(ispin), wf_r)
2733 END DO
2734 filename = "TOTAL_DENSITY"
2735 mpi_io = .true.
2736 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%TOT_DENSITY_CUBE", &
2737 extension=".cube", middle_name=trim(filename), file_position=my_pos_cube, &
2738 log_filename=.false., mpi_io=mpi_io)
2739 CALL cp_pw_to_cube(wf_r, unit_nr, "TOTAL DENSITY", &
2740 particles=particles, zeff=zcharge, &
2741 stride=section_get_ivals(dft_section, "PRINT%TOT_DENSITY_CUBE%STRIDE"), &
2742 max_file_size_mb=section_get_rval(dft_section, "PRINT%TOT_DENSITY_CUBE%MAX_FILE_SIZE_MB"), &
2743 mpi_io=mpi_io)
2744 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2745 "DFT%PRINT%TOT_DENSITY_CUBE", mpi_io=mpi_io)
2746 CALL auxbas_pw_pool%give_back_pw(wf_r)
2747 END IF
2748
2749 e_density_section = cube_or_openpmd(input, str_e_density_cubes, str_e_density_openpmd, logger)
2750
2751 ! Write cube file with electron density
2752 IF (e_density_section%do_output) THEN
2753 CALL section_vals_val_get(dft_section, &
2754 keyword_name=e_density_section%concat_to_relative("%DENSITY_INCLUDE"), &
2755 c_val=print_density)
2756 print_density = trim(print_density)
2757 ! For openPMD, refer to access modes instead of APPEND key
2758 IF (e_density_section%grid_output == grid_output_cubes) THEN
2759 append_cube = section_get_lval(input, e_density_section%concat_to_absolute("%APPEND"))
2760 END IF
2761 my_pos_cube = "REWIND"
2762 IF (append_cube) THEN
2763 my_pos_cube = "APPEND"
2764 END IF
2765 ! Write the info on core densities for the interface between cp2k and the XRD code
2766 ! together with the valence density they are used to compute the form factor (Fourier transform)
2767 IF (e_density_section%grid_output == grid_output_cubes) THEN
2768 xrd_interface = section_get_lval(input, e_density_section%concat_to_absolute("%XRD_INTERFACE"))
2769 ELSE
2770 ! Unimplemented for openPMD, since this does not use the regular routines
2771 xrd_interface = .false.
2772 END IF
2773
2774 IF (xrd_interface) THEN
2775 !cube file only contains soft density (GAPW)
2776 IF (dft_control%qs_control%gapw) print_density = "SOFT_DENSITY"
2777
2778 filename = "ELECTRON_DENSITY"
2779 unit_nr = cp_print_key_unit_nr(logger, input, e_density_section%absolute_section_key, &
2780 extension=".xrd", middle_name=trim(filename), &
2781 file_position=my_pos_cube, log_filename=.false.)
2782 ngto = section_get_ival(input, e_density_section%concat_to_absolute("%NGAUSS"))
2783 IF (output_unit > 0) THEN
2784 INQUIRE (unit=unit_nr, name=filename)
2785 WRITE (unit=output_unit, fmt="(/,T2,A,/,/,T2,A)") &
2786 "The electron density (atomic part) is written to the file:", &
2787 trim(filename)
2788 END IF
2789
2790 xc_section => section_vals_get_subs_vals(input, "DFT%XC")
2791 nkind = SIZE(atomic_kind_set)
2792 IF (unit_nr > 0) THEN
2793 WRITE (unit_nr, *) "Atomic (core) densities"
2794 WRITE (unit_nr, *) "Unit cell"
2795 WRITE (unit_nr, fmt="(3F20.12)") cell%hmat(1, 1), cell%hmat(1, 2), cell%hmat(1, 3)
2796 WRITE (unit_nr, fmt="(3F20.12)") cell%hmat(2, 1), cell%hmat(2, 2), cell%hmat(2, 3)
2797 WRITE (unit_nr, fmt="(3F20.12)") cell%hmat(3, 1), cell%hmat(3, 2), cell%hmat(3, 3)
2798 WRITE (unit_nr, *) "Atomic types"
2799 WRITE (unit_nr, *) nkind
2800 END IF
2801 ! calculate atomic density and core density
2802 ALLOCATE (ppdens(ngto, 2, nkind), aedens(ngto, 2, nkind), ccdens(ngto, 2, nkind))
2803 DO ikind = 1, nkind
2804 atomic_kind => atomic_kind_set(ikind)
2805 qs_kind => qs_kind_set(ikind)
2806 CALL get_atomic_kind(atomic_kind, name=name, element_symbol=element_symbol)
2807 CALL calculate_atomic_density(ppdens(:, :, ikind), atomic_kind, qs_kind, ngto, &
2808 iunit=output_unit, confine=.true.)
2809 CALL calculate_atomic_density(aedens(:, :, ikind), atomic_kind, qs_kind, ngto, &
2810 iunit=output_unit, allelectron=.true., confine=.true.)
2811 ccdens(:, 1, ikind) = aedens(:, 1, ikind)
2812 ccdens(:, 2, ikind) = 0._dp
2813 CALL project_function_a(ccdens(1:ngto, 2, ikind), ccdens(1:ngto, 1, ikind), &
2814 ppdens(1:ngto, 2, ikind), ppdens(1:ngto, 1, ikind), 0)
2815 ccdens(:, 2, ikind) = aedens(:, 2, ikind) - ccdens(:, 2, ikind)
2816 IF (unit_nr > 0) THEN
2817 WRITE (unit_nr, fmt="(I6,A10,A20)") ikind, trim(element_symbol), trim(name)
2818 WRITE (unit_nr, fmt="(I6)") ngto
2819 WRITE (unit_nr, *) " Total density"
2820 WRITE (unit_nr, fmt="(2G24.12)") (aedens(i, 1, ikind), aedens(i, 2, ikind), i=1, ngto)
2821 WRITE (unit_nr, *) " Core density"
2822 WRITE (unit_nr, fmt="(2G24.12)") (ccdens(i, 1, ikind), ccdens(i, 2, ikind), i=1, ngto)
2823 END IF
2824 NULLIFY (atomic_kind)
2825 END DO
2826
2827 IF (dft_control%qs_control%gapw) THEN
2828 CALL get_qs_env(qs_env=qs_env, rho_atom_set=rho_atom_set)
2829
2830 IF (unit_nr > 0) THEN
2831 WRITE (unit_nr, *) "Coordinates and GAPW density"
2832 END IF
2833 np = particles%n_els
2834 DO iat = 1, np
2835 CALL get_atomic_kind(particles%els(iat)%atomic_kind, kind_number=ikind)
2836 CALL get_qs_kind(qs_kind_set(ikind), grid_atom=grid_atom)
2837 rho_atom => rho_atom_set(iat)
2838 IF (ASSOCIATED(rho_atom%rho_rad_h(1)%r_coef)) THEN
2839 nr = SIZE(rho_atom%rho_rad_h(1)%r_coef, 1)
2840 niso = SIZE(rho_atom%rho_rad_h(1)%r_coef, 2)
2841 ELSE
2842 nr = 0
2843 niso = 0
2844 END IF
2845 CALL para_env%sum(nr)
2846 CALL para_env%sum(niso)
2847
2848 ALLOCATE (bfun(nr, niso))
2849 bfun = 0._dp
2850 DO ispin = 1, dft_control%nspins
2851 IF (ASSOCIATED(rho_atom%rho_rad_h(1)%r_coef)) THEN
2852 bfun(:, :) = bfun + rho_atom%rho_rad_h(ispin)%r_coef - rho_atom%rho_rad_s(ispin)%r_coef
2853 END IF
2854 END DO
2855 CALL para_env%sum(bfun)
2856 ccdens(:, 1, ikind) = ppdens(:, 1, ikind)
2857 ccdens(:, 2, ikind) = 0._dp
2858 IF (unit_nr > 0) THEN
2859 WRITE (unit_nr, '(I10,I5,3f12.6)') iat, ikind, particles%els(iat)%r
2860 END IF
2861 DO iso = 1, niso
2862 l = indso(1, iso)
2863 CALL project_function_b(ccdens(:, 2, ikind), ccdens(:, 1, ikind), bfun(:, iso), grid_atom, l)
2864 IF (unit_nr > 0) THEN
2865 WRITE (unit_nr, fmt="(3I6)") iso, l, ngto
2866 WRITE (unit_nr, fmt="(2G24.12)") (ccdens(i, 1, ikind), ccdens(i, 2, ikind), i=1, ngto)
2867 END IF
2868 END DO
2869 DEALLOCATE (bfun)
2870 END DO
2871 ELSE
2872 IF (unit_nr > 0) THEN
2873 WRITE (unit_nr, *) "Coordinates"
2874 np = particles%n_els
2875 DO iat = 1, np
2876 CALL get_atomic_kind(particles%els(iat)%atomic_kind, kind_number=ikind)
2877 WRITE (unit_nr, '(I10,I5,3f12.6)') iat, ikind, particles%els(iat)%r
2878 END DO
2879 END IF
2880 END IF
2881
2882 DEALLOCATE (ppdens, aedens, ccdens)
2883
2884 CALL cp_print_key_finished_output(unit_nr, logger, input, &
2885 e_density_section%absolute_section_key)
2886
2887 END IF
2888 IF (dft_control%qs_control%gapw .AND. print_density == "TOTAL_DENSITY") THEN
2889 ! total density in g-space not implemented for k-points
2890 cpassert(.NOT. do_kpoints)
2891 ! Print total electronic density
2892 CALL get_qs_env(qs_env=qs_env, &
2893 pw_env=pw_env)
2894 CALL pw_env_get(pw_env=pw_env, &
2895 auxbas_pw_pool=auxbas_pw_pool, &
2896 pw_pools=pw_pools)
2897 CALL auxbas_pw_pool%create_pw(pw=rho_elec_rspace)
2898 CALL pw_zero(rho_elec_rspace)
2899 CALL auxbas_pw_pool%create_pw(pw=rho_elec_gspace)
2900 CALL pw_zero(rho_elec_gspace)
2901 CALL get_pw_grid_info(pw_grid=rho_elec_gspace%pw_grid, &
2902 dr=dr, &
2903 vol=volume)
2904 q_max = sqrt(sum((pi/dr(:))**2))
2905 CALL calculate_rhotot_elec_gspace(qs_env=qs_env, &
2906 auxbas_pw_pool=auxbas_pw_pool, &
2907 rhotot_elec_gspace=rho_elec_gspace, &
2908 q_max=q_max, &
2909 rho_hard=rho_hard, &
2910 rho_soft=rho_soft)
2911 rho_total = rho_hard + rho_soft
2912 CALL get_pw_grid_info(pw_grid=rho_elec_gspace%pw_grid, &
2913 vol=volume)
2914 ! rhotot pw coefficients are by default scaled by grid volume
2915 ! need to undo this to get proper charge from printed cube
2916 CALL pw_scale(rho_elec_gspace, 1.0_dp/volume)
2917
2918 CALL pw_transfer(rho_elec_gspace, rho_elec_rspace)
2919 rho_total_rspace = pw_integrate_function(rho_elec_rspace, isign=-1)
2920 filename = "TOTAL_ELECTRON_DENSITY"
2921 mpi_io = .true.
2922 unit_nr = e_density_section%print_key_unit_nr( &
2923 logger, &
2924 input, &
2925 e_density_section%absolute_section_key, &
2926 extension=".cube", &
2927 middle_name=trim(filename), &
2928 file_position=my_pos_cube, &
2929 log_filename=.false., &
2930 mpi_io=mpi_io, &
2931 fout=mpi_filename, &
2932 openpmd_basename="dft-total-electron-density", &
2933 openpmd_unit_dimension=openpmd_unit_dimension_density, &
2934 openpmd_unit_si=openpmd_unit_si_density, &
2935 sim_time=qs_env%sim_time)
2936 IF (output_unit > 0) THEN
2937 IF (.NOT. mpi_io) THEN
2938 INQUIRE (unit=unit_nr, name=filename)
2939 ELSE
2940 filename = mpi_filename
2941 END IF
2942 CALL print_density_output_message(output_unit, "The total electron density", &
2943 e_density_section, filename)
2944 WRITE (unit=output_unit, fmt="(/,(T2,A,F20.10))") &
2945 "q(max) [1/Angstrom] :", q_max/angstrom, &
2946 "Soft electronic charge (G-space) :", rho_soft, &
2947 "Hard electronic charge (G-space) :", rho_hard, &
2948 "Total electronic charge (G-space):", rho_total, &
2949 "Total electronic charge (R-space):", rho_total_rspace
2950 END IF
2951 CALL e_density_section%write_pw(rho_elec_rspace, unit_nr, "TOTAL ELECTRON DENSITY", &
2952 particles=particles, zeff=zcharge, &
2953 stride=section_get_ivals(dft_section, e_density_section%concat_to_relative("%STRIDE")), mpi_io=mpi_io)
2954 CALL e_density_section%print_key_finished_output(unit_nr, logger, input, &
2955 e_density_section%absolute_section_key, mpi_io=mpi_io)
2956 ! Print total spin density for spin-polarized systems
2957 IF (dft_control%nspins > 1) THEN
2958 CALL pw_zero(rho_elec_gspace)
2959 CALL pw_zero(rho_elec_rspace)
2960 CALL calculate_rhotot_elec_gspace(qs_env=qs_env, &
2961 auxbas_pw_pool=auxbas_pw_pool, &
2962 rhotot_elec_gspace=rho_elec_gspace, &
2963 q_max=q_max, &
2964 rho_hard=rho_hard, &
2965 rho_soft=rho_soft, &
2966 fsign=-1.0_dp)
2967 rho_total = rho_hard + rho_soft
2968
2969 ! rhotot pw coefficients are by default scaled by grid volume
2970 ! need to undo this to get proper charge from printed cube
2971 CALL pw_scale(rho_elec_gspace, 1.0_dp/volume)
2972
2973 CALL pw_transfer(rho_elec_gspace, rho_elec_rspace)
2974 rho_total_rspace = pw_integrate_function(rho_elec_rspace, isign=-1)
2975 filename = "TOTAL_SPIN_DENSITY"
2976 mpi_io = .true.
2977 unit_nr = e_density_section%print_key_unit_nr( &
2978 logger, &
2979 input, &
2980 e_density_section%absolute_section_key, &
2981 extension=".cube", &
2982 middle_name=trim(filename), &
2983 file_position=my_pos_cube, &
2984 log_filename=.false., &
2985 mpi_io=mpi_io, &
2986 fout=mpi_filename, &
2987 openpmd_basename="dft-total-spin-density", &
2988 openpmd_unit_dimension=openpmd_unit_dimension_density, &
2989 openpmd_unit_si=openpmd_unit_si_density, &
2990 sim_time=qs_env%sim_time)
2991 IF (output_unit > 0) THEN
2992 IF (.NOT. mpi_io .AND. e_density_section%grid_output == grid_output_cubes) THEN
2993 INQUIRE (unit=unit_nr, name=filename)
2994 ELSE
2995 filename = mpi_filename
2996 END IF
2997 CALL print_density_output_message(output_unit, "The total spin density", &
2998 e_density_section, filename)
2999 WRITE (unit=output_unit, fmt="(/,(T2,A,F20.10))") &
3000 "q(max) [1/Angstrom] :", q_max/angstrom, &
3001 "Soft part of the spin density (G-space):", rho_soft, &
3002 "Hard part of the spin density (G-space):", rho_hard, &
3003 "Total spin density (G-space) :", rho_total, &
3004 "Total spin density (R-space) :", rho_total_rspace
3005 END IF
3006 CALL e_density_section%write_pw(rho_elec_rspace, unit_nr, "TOTAL SPIN DENSITY", &
3007 particles=particles, zeff=zcharge, &
3008 stride=section_get_ivals(dft_section, e_density_section%concat_to_relative("%STRIDE")), mpi_io=mpi_io)
3009 CALL e_density_section%print_key_finished_output(unit_nr, logger, input, &
3010 e_density_section%absolute_section_key, mpi_io=mpi_io)
3011 END IF
3012 CALL auxbas_pw_pool%give_back_pw(rho_elec_gspace)
3013 CALL auxbas_pw_pool%give_back_pw(rho_elec_rspace)
3014
3015 ELSE IF (print_density == "SOFT_DENSITY" .OR. .NOT. dft_control%qs_control%gapw) THEN
3016 IF (dft_control%nspins > 1) THEN
3017 CALL get_qs_env(qs_env=qs_env, &
3018 pw_env=pw_env)
3019 CALL pw_env_get(pw_env=pw_env, &
3020 auxbas_pw_pool=auxbas_pw_pool, &
3021 pw_pools=pw_pools)
3022 CALL auxbas_pw_pool%create_pw(pw=rho_elec_rspace)
3023 CALL pw_copy(rho_r(1), rho_elec_rspace)
3024 CALL pw_axpy(rho_r(2), rho_elec_rspace)
3025 filename = "ELECTRON_DENSITY"
3026 mpi_io = .true.
3027 unit_nr = e_density_section%print_key_unit_nr( &
3028 logger, &
3029 input, &
3030 e_density_section%absolute_section_key, &
3031 extension=".cube", &
3032 middle_name=trim(filename), &
3033 file_position=my_pos_cube, &
3034 log_filename=.false., &
3035 mpi_io=mpi_io, &
3036 fout=mpi_filename, &
3037 openpmd_basename="dft-electron-density", &
3038 openpmd_unit_dimension=openpmd_unit_dimension_density, &
3039 openpmd_unit_si=openpmd_unit_si_density, &
3040 sim_time=qs_env%sim_time)
3041 IF (output_unit > 0) THEN
3042 IF (.NOT. mpi_io .AND. e_density_section%grid_output == grid_output_cubes) THEN
3043 INQUIRE (unit=unit_nr, name=filename)
3044 ELSE
3045 filename = mpi_filename
3046 END IF
3047 CALL print_density_output_message(output_unit, "The sum of alpha and beta density", &
3048 e_density_section, filename)
3049 END IF
3050 CALL e_density_section%write_pw(rho_elec_rspace, unit_nr, "SUM OF ALPHA AND BETA DENSITY", &
3051 particles=particles, zeff=zcharge, stride=section_get_ivals(dft_section, e_density_section%concat_to_relative("%STRIDE")), &
3052 mpi_io=mpi_io)
3053 CALL e_density_section%print_key_finished_output(unit_nr, logger, input, &
3054 e_density_section%absolute_section_key, mpi_io=mpi_io)
3055 CALL pw_copy(rho_r(1), rho_elec_rspace)
3056 CALL pw_axpy(rho_r(2), rho_elec_rspace, alpha=-1.0_dp)
3057 filename = "SPIN_DENSITY"
3058 mpi_io = .true.
3059 unit_nr = e_density_section%print_key_unit_nr( &
3060 logger, &
3061 input, &
3062 e_density_section%absolute_section_key, &
3063 extension=".cube", &
3064 middle_name=trim(filename), &
3065 file_position=my_pos_cube, &
3066 log_filename=.false., &
3067 mpi_io=mpi_io, &
3068 fout=mpi_filename, &
3069 openpmd_basename="dft-spin-density", &
3070 openpmd_unit_dimension=openpmd_unit_dimension_density, &
3071 openpmd_unit_si=openpmd_unit_si_density, &
3072 sim_time=qs_env%sim_time)
3073 IF (output_unit > 0) THEN
3074 IF (.NOT. mpi_io .AND. e_density_section%grid_output == grid_output_cubes) THEN
3075 INQUIRE (unit=unit_nr, name=filename)
3076 ELSE
3077 filename = mpi_filename
3078 END IF
3079 CALL print_density_output_message(output_unit, "The spin density", &
3080 e_density_section, filename)
3081 END IF
3082 CALL e_density_section%write_pw(rho_elec_rspace, unit_nr, "SPIN DENSITY", &
3083 particles=particles, zeff=zcharge, &
3084 stride=section_get_ivals(dft_section, e_density_section%concat_to_relative("%STRIDE")), mpi_io=mpi_io)
3085 CALL e_density_section%print_key_finished_output(unit_nr, logger, input, &
3086 e_density_section%absolute_section_key, mpi_io=mpi_io)
3087 CALL auxbas_pw_pool%give_back_pw(rho_elec_rspace)
3088 ELSE
3089 filename = "ELECTRON_DENSITY"
3090 mpi_io = .true.
3091 unit_nr = e_density_section%print_key_unit_nr( &
3092 logger, &
3093 input, &
3094 e_density_section%absolute_section_key, &
3095 extension=".cube", &
3096 middle_name=trim(filename), &
3097 file_position=my_pos_cube, &
3098 log_filename=.false., &
3099 mpi_io=mpi_io, &
3100 fout=mpi_filename, &
3101 openpmd_basename="dft-electron-density", &
3102 openpmd_unit_dimension=openpmd_unit_dimension_density, &
3103 openpmd_unit_si=openpmd_unit_si_density, &
3104 sim_time=qs_env%sim_time)
3105 IF (output_unit > 0) THEN
3106 IF (.NOT. mpi_io .AND. e_density_section%grid_output == grid_output_cubes) THEN
3107 INQUIRE (unit=unit_nr, name=filename)
3108 ELSE
3109 filename = mpi_filename
3110 END IF
3111 CALL print_density_output_message(output_unit, "The electron density", &
3112 e_density_section, filename)
3113 END IF
3114 CALL e_density_section%write_pw(rho_r(1), unit_nr, "ELECTRON DENSITY", &
3115 particles=particles, zeff=zcharge, &
3116 stride=section_get_ivals(dft_section, e_density_section%concat_to_relative("%STRIDE")), mpi_io=mpi_io)
3117 CALL e_density_section%print_key_finished_output(unit_nr, logger, input, &
3118 e_density_section%absolute_section_key, mpi_io=mpi_io)
3119 END IF ! nspins
3120
3121 ELSE IF (dft_control%qs_control%gapw .AND. print_density == "TOTAL_HARD_APPROX") THEN
3122 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, rho0_mpole=rho0_mpole, natom=natom)
3123 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, pw_pools=pw_pools)
3124 CALL auxbas_pw_pool%create_pw(rho_elec_rspace)
3125
3126 NULLIFY (my_q0)
3127 ALLOCATE (my_q0(natom))
3128 my_q0 = 0.0_dp
3129
3130 ! (eta/pi)**3: normalization for 3d gaussian of form exp(-eta*r**2)
3131 norm_factor = sqrt((rho0_mpole%zet0_h/pi)**3)
3132
3133 ! store hard part of electronic density in array
3134 DO iat = 1, natom
3135 my_q0(iat) = sum(rho0_mpole%mp_rho(iat)%Q0(1:dft_control%nspins))*norm_factor
3136 END DO
3137 ! multiply coeff with gaussian and put on realspace grid
3138 ! coeff is the gaussian prefactor, eta the gaussian exponent
3139 CALL calculate_rho_resp_all(rho_elec_rspace, coeff=my_q0, natom=natom, eta=rho0_mpole%zet0_h, qs_env=qs_env)
3140 rho_hard = pw_integrate_function(rho_elec_rspace, isign=-1)
3141
3142 rho_soft = 0.0_dp
3143 DO ispin = 1, dft_control%nspins
3144 CALL pw_axpy(rho_r(ispin), rho_elec_rspace)
3145 rho_soft = rho_soft + pw_integrate_function(rho_r(ispin), isign=-1)
3146 END DO
3147
3148 rho_total_rspace = rho_soft + rho_hard
3149
3150 filename = "ELECTRON_DENSITY"
3151 mpi_io = .true.
3152 unit_nr = e_density_section%print_key_unit_nr( &
3153 logger, &
3154 input, &
3155 e_density_section%absolute_section_key, &
3156 extension=".cube", &
3157 middle_name=trim(filename), &
3158 file_position=my_pos_cube, &
3159 log_filename=.false., &
3160 mpi_io=mpi_io, &
3161 fout=mpi_filename, &
3162 openpmd_basename="dft-electron-density", &
3163 openpmd_unit_dimension=openpmd_unit_dimension_density, &
3164 openpmd_unit_si=openpmd_unit_si_density, &
3165 sim_time=qs_env%sim_time)
3166 IF (output_unit > 0) THEN
3167 IF (.NOT. mpi_io .AND. e_density_section%grid_output == grid_output_cubes) THEN
3168 INQUIRE (unit=unit_nr, name=filename)
3169 ELSE
3170 filename = mpi_filename
3171 END IF
3172 CALL print_density_output_message(output_unit, "The electron density", &
3173 e_density_section, filename)
3174 WRITE (unit=output_unit, fmt="(/,(T2,A,F20.10))") &
3175 "Soft electronic charge (R-space) :", rho_soft, &
3176 "Hard electronic charge (R-space) :", rho_hard, &
3177 "Total electronic charge (R-space):", rho_total_rspace
3178 END IF
3179 CALL e_density_section%write_pw(rho_elec_rspace, unit_nr, "ELECTRON DENSITY", &
3180 particles=particles, zeff=zcharge, stride=section_get_ivals(dft_section, e_density_section%concat_to_relative("%STRIDE")), &
3181 mpi_io=mpi_io)
3182 CALL e_density_section%print_key_finished_output(unit_nr, logger, input, &
3183 e_density_section%absolute_section_key, mpi_io=mpi_io)
3184
3185 !------------
3186 IF (dft_control%nspins > 1) THEN
3187 DO iat = 1, natom
3188 my_q0(iat) = (rho0_mpole%mp_rho(iat)%Q0(1) - rho0_mpole%mp_rho(iat)%Q0(2))*norm_factor
3189 END DO
3190 CALL pw_zero(rho_elec_rspace)
3191 CALL calculate_rho_resp_all(rho_elec_rspace, coeff=my_q0, natom=natom, eta=rho0_mpole%zet0_h, qs_env=qs_env)
3192 rho_hard = pw_integrate_function(rho_elec_rspace, isign=-1)
3193
3194 CALL pw_axpy(rho_r(1), rho_elec_rspace)
3195 CALL pw_axpy(rho_r(2), rho_elec_rspace, alpha=-1.0_dp)
3196 rho_soft = pw_integrate_function(rho_r(1), isign=-1) &
3197 - pw_integrate_function(rho_r(2), isign=-1)
3198
3199 rho_total_rspace = rho_soft + rho_hard
3200
3201 filename = "SPIN_DENSITY"
3202 mpi_io = .true.
3203 unit_nr = e_density_section%print_key_unit_nr( &
3204 logger, &
3205 input, &
3206 e_density_section%absolute_section_key, &
3207 extension=".cube", &
3208 middle_name=trim(filename), &
3209 file_position=my_pos_cube, &
3210 log_filename=.false., &
3211 mpi_io=mpi_io, &
3212 fout=mpi_filename, &
3213 openpmd_basename="dft-spin-density", &
3214 openpmd_unit_dimension=openpmd_unit_dimension_density, &
3215 openpmd_unit_si=openpmd_unit_si_density, &
3216 sim_time=qs_env%sim_time)
3217 IF (output_unit > 0) THEN
3218 IF (.NOT. mpi_io .AND. e_density_section%grid_output == grid_output_cubes) THEN
3219 INQUIRE (unit=unit_nr, name=filename)
3220 ELSE
3221 filename = mpi_filename
3222 END IF
3223 CALL print_density_output_message(output_unit, "The spin density", &
3224 e_density_section, filename)
3225 WRITE (unit=output_unit, fmt="(/,(T2,A,F20.10))") &
3226 "Soft part of the spin density :", rho_soft, &
3227 "Hard part of the spin density :", rho_hard, &
3228 "Total spin density (R-space) :", rho_total_rspace
3229 END IF
3230 CALL e_density_section%write_pw(rho_elec_rspace, unit_nr, "SPIN DENSITY", &
3231 particles=particles, zeff=zcharge, &
3232 stride=section_get_ivals(dft_section, e_density_section%concat_to_relative("%STRIDE")), mpi_io=mpi_io)
3233 CALL e_density_section%print_key_finished_output(unit_nr, logger, input, &
3234 e_density_section%absolute_section_key, mpi_io=mpi_io)
3235 END IF ! nspins
3236 CALL auxbas_pw_pool%give_back_pw(rho_elec_rspace)
3237 DEALLOCATE (my_q0)
3238 END IF ! print_density
3239 END IF ! print key
3240
3241 IF (btest(cp_print_key_should_output(logger%iter_info, &
3242 dft_section, "PRINT%ENERGY_WINDOWS"), cp_p_file) .AND. .NOT. do_kpoints) THEN
3243 CALL energy_windows(qs_env)
3244 END IF
3245
3246 ! Print the hartree potential
3247 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
3248 "DFT%PRINT%V_HARTREE_CUBE"), cp_p_file)) THEN
3249
3250 CALL get_qs_env(qs_env=qs_env, &
3251 pw_env=pw_env, &
3252 v_hartree_rspace=v_hartree_rspace)
3253 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
3254 CALL auxbas_pw_pool%create_pw(aux_r)
3255
3256 append_cube = section_get_lval(input, "DFT%PRINT%V_HARTREE_CUBE%APPEND")
3257 my_pos_cube = "REWIND"
3258 IF (append_cube) THEN
3259 my_pos_cube = "APPEND"
3260 END IF
3261 mpi_io = .true.
3262 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
3263 CALL pw_env_get(pw_env)
3264 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%V_HARTREE_CUBE", &
3265 extension=".cube", middle_name="v_hartree", file_position=my_pos_cube, mpi_io=mpi_io)
3266 udvol = 1.0_dp/v_hartree_rspace%pw_grid%dvol
3267
3268 CALL pw_copy(v_hartree_rspace, aux_r)
3269 CALL pw_scale(aux_r, udvol)
3270
3271 CALL cp_pw_to_cube(aux_r, unit_nr, "HARTREE POTENTIAL", particles=particles, zeff=zcharge, &
3272 stride=section_get_ivals(dft_section, "PRINT%V_HARTREE_CUBE%STRIDE"), &
3273 max_file_size_mb=section_get_rval(dft_section, "PRINT%V_HARTREE_CUBE%MAX_FILE_SIZE_MB"), &
3274 mpi_io=mpi_io)
3275 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3276 "DFT%PRINT%V_HARTREE_CUBE", mpi_io=mpi_io)
3277
3278 CALL auxbas_pw_pool%give_back_pw(aux_r)
3279 END IF
3280
3281 ! Print the external potential
3282 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
3283 "DFT%PRINT%EXTERNAL_POTENTIAL_CUBE"), cp_p_file)) THEN
3284 IF (dft_control%apply_external_potential) THEN
3285 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, vee=vee)
3286 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
3287 CALL auxbas_pw_pool%create_pw(aux_r)
3288
3289 append_cube = section_get_lval(input, "DFT%PRINT%EXTERNAL_POTENTIAL_CUBE%APPEND")
3290 my_pos_cube = "REWIND"
3291 IF (append_cube) THEN
3292 my_pos_cube = "APPEND"
3293 END IF
3294 mpi_io = .true.
3295 CALL pw_env_get(pw_env)
3296 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%EXTERNAL_POTENTIAL_CUBE", &
3297 extension=".cube", middle_name="ext_pot", file_position=my_pos_cube, mpi_io=mpi_io)
3298
3299 CALL pw_copy(vee, aux_r)
3300
3301 CALL cp_pw_to_cube(aux_r, unit_nr, "EXTERNAL POTENTIAL", particles=particles, zeff=zcharge, &
3302 stride=section_get_ivals(dft_section, "PRINT%EXTERNAL_POTENTIAL_CUBE%STRIDE"), &
3303 max_file_size_mb=section_get_rval(dft_section, "PRINT%EXTERNAL_POTENTIAL_CUBE%MAX_FILE_SIZE_MB"), &
3304 mpi_io=mpi_io)
3305 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3306 "DFT%PRINT%EXTERNAL_POTENTIAL_CUBE", mpi_io=mpi_io)
3307
3308 CALL auxbas_pw_pool%give_back_pw(aux_r)
3309 END IF
3310 END IF
3311
3312 ! Print the Electrical Field Components
3313 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
3314 "DFT%PRINT%EFIELD_CUBE"), cp_p_file)) THEN
3315
3316 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
3317 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
3318 CALL auxbas_pw_pool%create_pw(aux_r)
3319 CALL auxbas_pw_pool%create_pw(aux_g)
3320
3321 append_cube = section_get_lval(input, "DFT%PRINT%EFIELD_CUBE%APPEND")
3322 my_pos_cube = "REWIND"
3323 IF (append_cube) THEN
3324 my_pos_cube = "APPEND"
3325 END IF
3326 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, &
3327 v_hartree_rspace=v_hartree_rspace)
3328 CALL pw_env_get(pw_env)
3329 udvol = 1.0_dp/v_hartree_rspace%pw_grid%dvol
3330 DO id = 1, 3
3331 mpi_io = .true.
3332 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%EFIELD_CUBE", &
3333 extension=".cube", middle_name="efield_"//cdir(id), file_position=my_pos_cube, &
3334 mpi_io=mpi_io)
3335
3336 CALL pw_transfer(v_hartree_rspace, aux_g)
3337 nd = 0
3338 nd(id) = 1
3339 CALL pw_derive(aux_g, nd)
3340 CALL pw_transfer(aux_g, aux_r)
3341 CALL pw_scale(aux_r, udvol)
3342
3343 CALL cp_pw_to_cube(aux_r, unit_nr, "ELECTRIC FIELD", particles=particles, zeff=zcharge, &
3344 stride=section_get_ivals(dft_section, "PRINT%EFIELD_CUBE%STRIDE"), &
3345 max_file_size_mb=section_get_rval(dft_section, "PRINT%EFIELD_CUBE%MAX_FILE_SIZE_MB"), &
3346 mpi_io=mpi_io)
3347 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3348 "DFT%PRINT%EFIELD_CUBE", mpi_io=mpi_io)
3349 END DO
3350
3351 CALL auxbas_pw_pool%give_back_pw(aux_r)
3352 CALL auxbas_pw_pool%give_back_pw(aux_g)
3353 END IF
3354
3355 ! Write cube files from the local energy
3356 CALL qs_scf_post_local_energy(input, logger, qs_env)
3357
3358 ! Write cube files from the local stress tensor
3359 CALL qs_scf_post_local_stress(input, logger, qs_env)
3360
3361 ! Write cube files from the implicit Poisson solver
3362 CALL qs_scf_post_ps_implicit(input, logger, qs_env)
3363
3364 ! post SCF finite-volume Kubo transport
3365 CALL qs_scf_post_kubo_transport(qs_env)
3366
3367 CALL qs_scf_post_localizer(qs_env)
3368 CALL qs_scf_post_quadratic(qs_env)
3369
3370 ! post SCF Transport
3371 CALL qs_scf_post_transport(qs_env)
3372
3373 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%OMIT_HEADERS", l_val=omit_headers)
3374 ! Write the density matrices
3375 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
3376 "DFT%PRINT%AO_MATRICES/DENSITY"), cp_p_file)) THEN
3377 iw = cp_print_key_unit_nr(logger, input, "DFT%PRINT%AO_MATRICES/DENSITY", &
3378 extension=".Log")
3379 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
3380 CALL qs_rho_get(rho, rho_ao_kp=rho_ao)
3381 after = min(max(after, 1), 16)
3382 DO ispin = 1, dft_control%nspins
3383 DO img = 1, dft_control%nimages
3384 CALL cp_dbcsr_write_sparse_matrix(rho_ao(ispin, img)%matrix, 4, after, qs_env, &
3385 para_env, output_unit=iw, omit_headers=omit_headers)
3386 END DO
3387 END DO
3388 CALL cp_print_key_finished_output(iw, logger, input, &
3389 "DFT%PRINT%AO_MATRICES/DENSITY")
3390 END IF
3391
3392 ! Write the Kohn-Sham matrices
3393 write_ks = btest(cp_print_key_should_output(logger%iter_info, input, &
3394 "DFT%PRINT%AO_MATRICES/KOHN_SHAM_MATRIX"), cp_p_file)
3395 write_xc = btest(cp_print_key_should_output(logger%iter_info, input, &
3396 "DFT%PRINT%AO_MATRICES/MATRIX_VXC"), cp_p_file)
3397 ! we need to update stuff before writing, potentially computing the matrix_vxc
3398 IF (write_ks .OR. write_xc) THEN
3399 IF (write_xc) qs_env%requires_matrix_vxc = .true.
3400 CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.true.)
3401 CALL qs_ks_update_qs_env(qs_env, calculate_forces=.false., &
3402 just_energy=.false.)
3403 IF (write_xc) qs_env%requires_matrix_vxc = .false.
3404 END IF
3405
3406 ! Write the Kohn-Sham matrices
3407 IF (write_ks) THEN
3408 iw = cp_print_key_unit_nr(logger, input, "DFT%PRINT%AO_MATRICES/KOHN_SHAM_MATRIX", &
3409 extension=".Log")
3410 CALL get_qs_env(qs_env=qs_env, matrix_ks_kp=ks_rmpv)
3411 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
3412 after = min(max(after, 1), 16)
3413 DO ispin = 1, dft_control%nspins
3414 DO img = 1, dft_control%nimages
3415 CALL cp_dbcsr_write_sparse_matrix(ks_rmpv(ispin, img)%matrix, 4, after, qs_env, &
3416 para_env, output_unit=iw, omit_headers=omit_headers)
3417 END DO
3418 END DO
3419 CALL cp_print_key_finished_output(iw, logger, input, &
3420 "DFT%PRINT%AO_MATRICES/KOHN_SHAM_MATRIX")
3421 END IF
3422
3423 ! write csr matrices
3424 ! matrices in terms of the PAO basis will be taken care of in pao_post_scf.
3425 IF (.NOT. dft_control%qs_control%pao) THEN
3426 CALL write_ks_matrix_csr(qs_env, input)
3427 CALL write_s_matrix_csr(qs_env, input)
3428 CALL write_hcore_matrix_csr(qs_env, input)
3429 CALL write_p_matrix_csr(qs_env, input)
3430 END IF
3431
3432 ! write adjacency matrix
3433 CALL write_adjacency_matrix(qs_env, input)
3434
3435 ! Write the xc matrix
3436 IF (write_xc) THEN
3437 CALL get_qs_env(qs_env=qs_env, matrix_vxc_kp=matrix_vxc)
3438 cpassert(ASSOCIATED(matrix_vxc))
3439 iw = cp_print_key_unit_nr(logger, input, "DFT%PRINT%AO_MATRICES/MATRIX_VXC", &
3440 extension=".Log")
3441 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
3442 after = min(max(after, 1), 16)
3443 DO ispin = 1, dft_control%nspins
3444 DO img = 1, dft_control%nimages
3445 CALL cp_dbcsr_write_sparse_matrix(matrix_vxc(ispin, img)%matrix, 4, after, qs_env, &
3446 para_env, output_unit=iw, omit_headers=omit_headers)
3447 END DO
3448 END DO
3449 CALL cp_print_key_finished_output(iw, logger, input, &
3450 "DFT%PRINT%AO_MATRICES/MATRIX_VXC")
3451 END IF
3452
3453 ! Write the [H,r] commutator matrices
3454 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
3455 "DFT%PRINT%AO_MATRICES/COMMUTATOR_HR"), cp_p_file)) THEN
3456 iw = cp_print_key_unit_nr(logger, input, "DFT%PRINT%AO_MATRICES/COMMUTATOR_HR", &
3457 extension=".Log")
3458 CALL section_vals_val_get(input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
3459 NULLIFY (matrix_hr)
3460 CALL dbcsr_allocate_matrix_set(matrix_hr, 3)
3461 DO img = 1, 3
3462 ALLOCATE (matrix_hr(img)%matrix)
3463 CALL dbcsr_create(matrix_hr(img)%matrix, template=matrix_s(1, 1)%matrix, &
3464 name="COMMUTATOR", matrix_type=dbcsr_type_antisymmetric)
3465 CALL cp_dbcsr_alloc_block_from_nbl(matrix_hr(img)%matrix, sab_orb)
3466 CALL dbcsr_set(matrix_hr(img)%matrix, 0._dp)
3467 END DO
3468
3469 CALL build_com_mom_nl(qs_kind_set, sab_orb, sap_ppnl, dft_control%qs_control%eps_ppnl, &
3470 particle_set, cell, matrix_rv=matrix_hr)
3471 CALL build_lin_mom_matrix(qs_env, matrix_hr)
3472 DO img = 1, 3
3473 CALL dbcsr_scale(matrix_hr(img)%matrix, alpha_scalar=-1._dp)
3474 checksum_hr(img) = dbcsr_checksum(matrix_hr(img)%matrix)
3475 END DO
3476 IF (output_unit > 0) THEN
3477 WRITE (output_unit, '(T2,A,E23.16)') 'COMMUTATOR_HR| CheckSum X =', checksum_hr(1)
3478 WRITE (output_unit, '(T2,A,E23.16)') 'COMMUTATOR_HR| CheckSum Y =', checksum_hr(2)
3479 WRITE (output_unit, '(T2,A,E23.16)') 'COMMUTATOR_HR| CheckSum Z =', checksum_hr(3)
3480 END IF
3481 after = min(max(after, 1), 16)
3482 DO img = 1, 3
3483 CALL cp_dbcsr_write_sparse_matrix(matrix_hr(img)%matrix, 4, after, qs_env, &
3484 para_env, output_unit=iw, omit_headers=omit_headers)
3485 END DO
3486 CALL dbcsr_deallocate_matrix_set(matrix_hr)
3487 CALL cp_print_key_finished_output(iw, logger, input, &
3488 "DFT%PRINT%AO_MATRICES/COMMUTATOR_HR")
3489 END IF
3490
3491 ! Compute the Mulliken charges
3492 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%MULLIKEN")
3493 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
3494 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MULLIKEN", extension=".mulliken", log_filename=.false.)
3495 print_level = 1
3496 CALL section_vals_val_get(print_key, "PRINT_GOP", l_val=print_it)
3497 IF (print_it) print_level = 2
3498 CALL section_vals_val_get(print_key, "PRINT_ALL", l_val=print_it)
3499 IF (print_it) print_level = 3
3500 CALL mulliken_population_analysis(qs_env, unit_nr, print_level)
3501 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MULLIKEN")
3502 END IF
3503
3504 ! Compute the Hirshfeld charges
3505 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%HIRSHFELD")
3506 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
3507 ! we check if real space density is available
3508 NULLIFY (rho)
3509 CALL get_qs_env(qs_env=qs_env, rho=rho)
3510 CALL qs_rho_get(rho, rho_r_valid=rho_r_valid)
3511 IF (rho_r_valid) THEN
3512 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%HIRSHFELD", extension=".hirshfeld", log_filename=.false.)
3513 CALL hirshfeld_charges(qs_env, print_key, unit_nr)
3514 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%HIRSHFELD")
3515 END IF
3516 END IF
3517
3518 ! Compute EEQ charges
3519 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%EEQ_CHARGES")
3520 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
3521 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%EEQ_CHARGES", extension=".eeq", log_filename=.false.)
3522 print_level = 1
3523 CALL eeq_print(qs_env, unit_nr, print_level, ext=.false.)
3524 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MULLIKEN")
3525 END IF
3526
3527 ! Do a Voronoi Integration or write a compressed BQB File
3528 print_key_voro => section_vals_get_subs_vals(input, "DFT%PRINT%VORONOI")
3529 print_key_bqb => section_vals_get_subs_vals(input, "DFT%PRINT%E_DENSITY_BQB")
3530 IF (btest(cp_print_key_should_output(logger%iter_info, print_key_voro), cp_p_file)) THEN
3531 should_print_voro = 1
3532 ELSE
3533 should_print_voro = 0
3534 END IF
3535 IF (btest(cp_print_key_should_output(logger%iter_info, print_key_bqb), cp_p_file)) THEN
3536 should_print_bqb = 1
3537 ELSE
3538 should_print_bqb = 0
3539 END IF
3540 IF ((should_print_voro /= 0) .OR. (should_print_bqb /= 0)) THEN
3541
3542 ! we check if real space density is available
3543 NULLIFY (rho)
3544 CALL get_qs_env(qs_env=qs_env, rho=rho)
3545 CALL qs_rho_get(rho, rho_r_valid=rho_r_valid)
3546 IF (rho_r_valid) THEN
3547
3548 IF (dft_control%nspins > 1) THEN
3549 CALL get_qs_env(qs_env=qs_env, &
3550 pw_env=pw_env)
3551 CALL pw_env_get(pw_env=pw_env, &
3552 auxbas_pw_pool=auxbas_pw_pool, &
3553 pw_pools=pw_pools)
3554 NULLIFY (mb_rho)
3555 ALLOCATE (mb_rho)
3556 CALL auxbas_pw_pool%create_pw(pw=mb_rho)
3557 CALL pw_copy(rho_r(1), mb_rho)
3558 CALL pw_axpy(rho_r(2), mb_rho)
3559 !CALL voronoi_analysis(qs_env, rho_elec_rspace, print_key, unit_nr)
3560 ELSE
3561 mb_rho => rho_r(1)
3562 !CALL voronoi_analysis( qs_env, rho_r(1), print_key, unit_nr )
3563 END IF ! nspins
3564
3565 IF (should_print_voro /= 0) THEN
3566 CALL section_vals_val_get(print_key_voro, "OUTPUT_TEXT", l_val=voro_print_txt)
3567 IF (voro_print_txt) THEN
3568 append_voro = section_get_lval(input, "DFT%PRINT%VORONOI%APPEND")
3569 my_pos_voro = "REWIND"
3570 IF (append_voro) THEN
3571 my_pos_voro = "APPEND"
3572 END IF
3573 unit_nr_voro = cp_print_key_unit_nr(logger, input, "DFT%PRINT%VORONOI", extension=".voronoi", &
3574 file_position=my_pos_voro, log_filename=.false.)
3575 ELSE
3576 unit_nr_voro = 0
3577 END IF
3578 ELSE
3579 unit_nr_voro = 0
3580 END IF
3581
3582 CALL entry_voronoi_or_bqb(should_print_voro, should_print_bqb, print_key_voro, print_key_bqb, &
3583 unit_nr_voro, qs_env, mb_rho)
3584
3585 IF (dft_control%nspins > 1) THEN
3586 CALL auxbas_pw_pool%give_back_pw(mb_rho)
3587 DEALLOCATE (mb_rho)
3588 END IF
3589
3590 IF (unit_nr_voro > 0) THEN
3591 CALL cp_print_key_finished_output(unit_nr_voro, logger, input, "DFT%PRINT%VORONOI")
3592 END IF
3593
3594 END IF
3595 END IF
3596
3597 ! MAO analysis
3598 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%MAO_ANALYSIS")
3599 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
3600 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MAO_ANALYSIS", extension=".mao", log_filename=.false.)
3601 CALL mao_analysis(qs_env, print_key, unit_nr)
3602 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MAO_ANALYSIS")
3603 END IF
3604
3605 ! MINBAS analysis
3606 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%MINBAS_ANALYSIS")
3607 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
3608 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%MINBAS_ANALYSIS", extension=".mao", log_filename=.false.)
3609 CALL minbas_analysis(qs_env, print_key, unit_nr)
3610 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%MINBAS_ANALYSIS")
3611 END IF
3612
3613 ! IAO analysis
3614 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%IAO_ANALYSIS")
3615 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
3616 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%IAO_ANALYSIS", extension=".iao", log_filename=.false.)
3617 CALL iao_read_input(iao_env, print_key, cell)
3618 IF (particle_set(1)%fragment_index /= 0) iao_env%do_fragments = .true.
3619 IF (iao_env%do_iao) THEN
3620 CALL iao_wfn_analysis(qs_env, iao_env, unit_nr)
3621 END IF
3622 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%IAO_ANALYSIS")
3623 END IF
3624
3625 ! Energy Decomposition Analysis
3626 print_key => section_vals_get_subs_vals(input, "DFT%PRINT%ENERGY_DECOMPOSITION_ANALYSIS")
3627 IF (btest(cp_print_key_should_output(logger%iter_info, print_key), cp_p_file)) THEN
3628 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%ENERGY_DECOMPOSITION_ANALYSIS", &
3629 extension=".mao", log_filename=.false.)
3630 CALL edmf_analysis(qs_env, print_key, unit_nr)
3631 CALL cp_print_key_finished_output(unit_nr, logger, input, "DFT%PRINT%ENERGY_DECOMPOSITION_ANALYSIS")
3632 END IF
3633
3634 ! Print the density in the RI-HFX basis
3635 hfx_section => section_vals_get_subs_vals(input, "DFT%XC%HF")
3636 CALL section_vals_get(hfx_section, explicit=do_hfx)
3637 CALL section_vals_get(hfx_section, n_repetition=n_rep_hf)
3638 IF (do_hfx) THEN
3639 DO i = 1, n_rep_hf
3640 IF (qs_env%x_data(i, 1)%do_hfx_ri) CALL print_ri_hfx(qs_env%x_data(i, 1)%ri_data, qs_env)
3641 END DO
3642 END IF
3643
3644 DEALLOCATE (zcharge)
3645
3646 CALL timestop(handle)
3647
3648 END SUBROUTINE write_mo_free_results
3649
3650! **************************************************************************************************
3651!> \brief Calculates Hirshfeld charges
3652!> \param qs_env the qs_env where to calculate the charges
3653!> \param input_section the input section for Hirshfeld charges
3654!> \param unit_nr the output unit number
3655! **************************************************************************************************
3656 SUBROUTINE hirshfeld_charges(qs_env, input_section, unit_nr)
3657 TYPE(qs_environment_type), POINTER :: qs_env
3658 TYPE(section_vals_type), POINTER :: input_section
3659 INTEGER, INTENT(IN) :: unit_nr
3660
3661 INTEGER :: i, iat, ikind, natom, nkind, nspin, &
3662 radius_type, refc, shapef
3663 INTEGER, DIMENSION(:), POINTER :: atom_list
3664 LOGICAL :: do_radius, do_sc, paw_atom
3665 REAL(kind=dp) :: zeff
3666 REAL(kind=dp), DIMENSION(:), POINTER :: radii
3667 REAL(kind=dp), DIMENSION(:, :), POINTER :: charges
3668 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
3669 TYPE(atomic_kind_type), POINTER :: atomic_kind
3670 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_p, matrix_s
3671 TYPE(dft_control_type), POINTER :: dft_control
3672 TYPE(hirshfeld_type), POINTER :: hirshfeld_env
3673 TYPE(mp_para_env_type), POINTER :: para_env
3674 TYPE(mpole_rho_atom), DIMENSION(:), POINTER :: mp_rho
3675 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
3676 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
3677 TYPE(qs_rho_type), POINTER :: rho
3678 TYPE(rho0_mpole_type), POINTER :: rho0_mpole
3679
3680 NULLIFY (hirshfeld_env)
3681 NULLIFY (radii)
3682 CALL create_hirshfeld_type(hirshfeld_env)
3683 !
3684 CALL get_qs_env(qs_env, nkind=nkind, natom=natom)
3685 ALLOCATE (hirshfeld_env%charges(natom))
3686 ! input options
3687 CALL section_vals_val_get(input_section, "SELF_CONSISTENT", l_val=do_sc)
3688 CALL section_vals_val_get(input_section, "USER_RADIUS", l_val=do_radius)
3689 CALL section_vals_val_get(input_section, "SHAPE_FUNCTION", i_val=shapef)
3690 CALL section_vals_val_get(input_section, "REFERENCE_CHARGE", i_val=refc)
3691 IF (do_radius) THEN
3692 radius_type = radius_user
3693 CALL section_vals_val_get(input_section, "ATOMIC_RADII", r_vals=radii)
3694 IF (.NOT. SIZE(radii) == nkind) THEN
3695 CALL cp_abort(__location__, &
3696 "Length of keyword HIRSHFELD\ATOMIC_RADII does not "// &
3697 "match number of atomic kinds in the input coordinate file.")
3698 END IF
3699 ELSE
3700 radius_type = radius_covalent
3701 END IF
3702 CALL set_hirshfeld_info(hirshfeld_env, shape_function_type=shapef, &
3703 iterative=do_sc, ref_charge=refc, &
3704 radius_type=radius_type)
3705 ! shape function
3706 CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, atomic_kind_set=atomic_kind_set)
3707 CALL create_shape_function(hirshfeld_env, qs_kind_set, atomic_kind_set, &
3708 radii_list=radii)
3709 ! reference charges
3710 CALL get_qs_env(qs_env, rho=rho)
3711 CALL qs_rho_get(rho, rho_ao_kp=matrix_p)
3712 nspin = SIZE(matrix_p, 1)
3713 ALLOCATE (charges(natom, nspin))
3714 SELECT CASE (refc)
3715 CASE (ref_charge_atomic)
3716 DO ikind = 1, nkind
3717 CALL get_qs_kind(qs_kind_set(ikind), zeff=zeff)
3718 atomic_kind => atomic_kind_set(ikind)
3719 CALL get_atomic_kind(atomic_kind, atom_list=atom_list)
3720 DO iat = 1, SIZE(atom_list)
3721 i = atom_list(iat)
3722 hirshfeld_env%charges(i) = zeff
3723 END DO
3724 END DO
3725 CASE (ref_charge_mulliken)
3726 CALL get_qs_env(qs_env, matrix_s_kp=matrix_s, para_env=para_env)
3727 CALL mulliken_charges(matrix_p, matrix_s, para_env, charges)
3728 DO iat = 1, natom
3729 hirshfeld_env%charges(iat) = sum(charges(iat, :))
3730 END DO
3731 CASE DEFAULT
3732 cpabort("Unknown type of reference charge for Hirshfeld partitioning.")
3733 END SELECT
3734 !
3735 charges = 0.0_dp
3736 IF (hirshfeld_env%iterative) THEN
3737 ! Hirshfeld-I charges
3738 CALL comp_hirshfeld_i_charges(qs_env, hirshfeld_env, charges, unit_nr)
3739 ELSE
3740 ! Hirshfeld charges
3741 CALL comp_hirshfeld_charges(qs_env, hirshfeld_env, charges)
3742 END IF
3743 CALL get_qs_env(qs_env, particle_set=particle_set, dft_control=dft_control)
3744 IF (dft_control%qs_control%gapw) THEN
3745 ! GAPW: add core charges (rho_hard - rho_soft)
3746 CALL get_qs_env(qs_env, rho0_mpole=rho0_mpole)
3747 CALL get_rho0_mpole(rho0_mpole, mp_rho=mp_rho)
3748 DO iat = 1, natom
3749 atomic_kind => particle_set(iat)%atomic_kind
3750 CALL get_atomic_kind(atomic_kind, kind_number=ikind)
3751 CALL get_qs_kind(qs_kind_set(ikind), paw_atom=paw_atom)
3752 IF (paw_atom) THEN
3753 charges(iat, 1:nspin) = charges(iat, 1:nspin) + mp_rho(iat)%q0(1:nspin)
3754 END IF
3755 END DO
3756 END IF
3757 !
3758 IF (unit_nr > 0) THEN
3759 CALL write_hirshfeld_charges(charges, hirshfeld_env, particle_set, &
3760 qs_kind_set, unit_nr)
3761 END IF
3762 ! Save the charges to the results under the tag [HIRSHFELD-CHARGES]
3763 CALL save_hirshfeld_charges(charges, particle_set, qs_kind_set, qs_env)
3764 !
3765 CALL release_hirshfeld_type(hirshfeld_env)
3766 DEALLOCATE (charges)
3767
3768 END SUBROUTINE hirshfeld_charges
3769
3770! **************************************************************************************************
3771!> \brief ...
3772!> \param ca ...
3773!> \param a ...
3774!> \param cb ...
3775!> \param b ...
3776!> \param l ...
3777! **************************************************************************************************
3778 SUBROUTINE project_function_a(ca, a, cb, b, l)
3779 ! project function cb on ca
3780 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: ca
3781 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: a, cb, b
3782 INTEGER, INTENT(IN) :: l
3783
3784 INTEGER :: info, n
3785 INTEGER, ALLOCATABLE, DIMENSION(:) :: ipiv
3786 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: smat, tmat, v
3787
3788 n = SIZE(ca)
3789 ALLOCATE (smat(n, n), tmat(n, n), v(n, 1), ipiv(n))
3790
3791 CALL sg_overlap(smat, l, a, a)
3792 CALL sg_overlap(tmat, l, a, b)
3793 v(:, 1) = matmul(tmat, cb)
3794 CALL dgesv(n, 1, smat, n, ipiv, v, n, info)
3795 cpassert(info == 0)
3796 ca(:) = v(:, 1)
3797
3798 DEALLOCATE (smat, tmat, v, ipiv)
3799
3800 END SUBROUTINE project_function_a
3801
3802! **************************************************************************************************
3803!> \brief ...
3804!> \param ca ...
3805!> \param a ...
3806!> \param bfun ...
3807!> \param grid_atom ...
3808!> \param l ...
3809! **************************************************************************************************
3810 SUBROUTINE project_function_b(ca, a, bfun, grid_atom, l)
3811 ! project function f on ca
3812 REAL(kind=dp), DIMENSION(:), INTENT(OUT) :: ca
3813 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: a, bfun
3814 TYPE(grid_atom_type), POINTER :: grid_atom
3815 INTEGER, INTENT(IN) :: l
3816
3817 INTEGER :: i, info, n, nr
3818 INTEGER, ALLOCATABLE, DIMENSION(:) :: ipiv
3819 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: afun
3820 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: smat, v
3821
3822 n = SIZE(ca)
3823 nr = grid_atom%nr
3824 ALLOCATE (smat(n, n), v(n, 1), ipiv(n), afun(nr))
3825
3826 CALL sg_overlap(smat, l, a, a)
3827 DO i = 1, n
3828 afun(:) = grid_atom%rad(:)**l*exp(-a(i)*grid_atom%rad2(:))
3829 v(i, 1) = sum(afun(:)*bfun(:)*grid_atom%wr(:))
3830 END DO
3831 CALL dgesv(n, 1, smat, n, ipiv, v, n, info)
3832 cpassert(info == 0)
3833 ca(:) = v(:, 1)
3834
3835 DEALLOCATE (smat, v, ipiv, afun)
3836
3837 END SUBROUTINE project_function_b
3838
3839! **************************************************************************************************
3840!> \brief Performs printing of cube files from local energy
3841!> \param input input
3842!> \param logger the logger
3843!> \param qs_env the qs_env in which the qs_env lives
3844!> \par History
3845!> 07.2019 created
3846!> \author JGH
3847! **************************************************************************************************
3848 SUBROUTINE qs_scf_post_local_energy(input, logger, qs_env)
3849 TYPE(section_vals_type), POINTER :: input
3850 TYPE(cp_logger_type), POINTER :: logger
3851 TYPE(qs_environment_type), POINTER :: qs_env
3852
3853 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_local_energy'
3854
3855 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube
3856 INTEGER :: handle, io_unit, natom, unit_nr
3857 LOGICAL :: append_cube, gapw, gapw_xc, mpi_io
3858 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: zcharge
3859 TYPE(dft_control_type), POINTER :: dft_control
3860 TYPE(particle_list_type), POINTER :: particles
3861 TYPE(pw_env_type), POINTER :: pw_env
3862 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
3863 TYPE(pw_r3d_rs_type) :: eden
3864 TYPE(qs_subsys_type), POINTER :: subsys
3865 TYPE(section_vals_type), POINTER :: dft_section
3866
3867 CALL timeset(routinen, handle)
3868 io_unit = cp_logger_get_default_io_unit(logger)
3869 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
3870 "DFT%PRINT%LOCAL_ENERGY_CUBE"), cp_p_file)) THEN
3871 dft_section => section_vals_get_subs_vals(input, "DFT")
3872 CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, natom=natom)
3873 gapw = dft_control%qs_control%gapw
3874 gapw_xc = dft_control%qs_control%gapw_xc
3875 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, subsys=subsys)
3876 CALL qs_subsys_get(subsys, particles=particles)
3877 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
3878 CALL auxbas_pw_pool%create_pw(eden)
3879 !
3880 CALL qs_local_energy(qs_env, eden)
3881 CALL get_effective_core_charges(qs_env, zcharge)
3882 !
3883 append_cube = section_get_lval(input, "DFT%PRINT%LOCAL_ENERGY_CUBE%APPEND")
3884 IF (append_cube) THEN
3885 my_pos_cube = "APPEND"
3886 ELSE
3887 my_pos_cube = "REWIND"
3888 END IF
3889 mpi_io = .true.
3890 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%LOCAL_ENERGY_CUBE", &
3891 extension=".cube", middle_name="local_energy", &
3892 file_position=my_pos_cube, mpi_io=mpi_io)
3893 CALL cp_pw_to_cube(eden, unit_nr, "LOCAL ENERGY", particles=particles, zeff=zcharge, &
3894 stride=section_get_ivals(dft_section, "PRINT%LOCAL_ENERGY_CUBE%STRIDE"), &
3895 max_file_size_mb=section_get_rval(dft_section, "PRINT%LOCAL_ENERGY_CUBE%MAX_FILE_SIZE_MB"), &
3896 mpi_io=mpi_io)
3897 IF (io_unit > 0) THEN
3898 INQUIRE (unit=unit_nr, name=filename)
3899 IF (gapw .OR. gapw_xc) THEN
3900 WRITE (unit=io_unit, fmt="(/,T3,A,A)") &
3901 "The soft part of the local energy is written to the file: ", trim(adjustl(filename))
3902 ELSE
3903 WRITE (unit=io_unit, fmt="(/,T3,A,A)") &
3904 "The local energy is written to the file: ", trim(adjustl(filename))
3905 END IF
3906 END IF
3907 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3908 "DFT%PRINT%LOCAL_ENERGY_CUBE", mpi_io=mpi_io)
3909 !
3910 CALL auxbas_pw_pool%give_back_pw(eden)
3911 DEALLOCATE (zcharge)
3912 END IF
3913 CALL timestop(handle)
3914
3915 END SUBROUTINE qs_scf_post_local_energy
3916
3917! **************************************************************************************************
3918!> \brief Performs printing of cube files from local energy
3919!> \param input input
3920!> \param logger the logger
3921!> \param qs_env the qs_env in which the qs_env lives
3922!> \par History
3923!> 07.2019 created
3924!> \author JGH
3925! **************************************************************************************************
3926 SUBROUTINE qs_scf_post_local_stress(input, logger, qs_env)
3927 TYPE(section_vals_type), POINTER :: input
3928 TYPE(cp_logger_type), POINTER :: logger
3929 TYPE(qs_environment_type), POINTER :: qs_env
3930
3931 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_local_stress'
3932
3933 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube
3934 INTEGER :: handle, io_unit, natom, unit_nr
3935 LOGICAL :: append_cube, gapw, gapw_xc, mpi_io
3936 REAL(kind=dp) :: beta
3937 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: zcharge
3938 TYPE(dft_control_type), POINTER :: dft_control
3939 TYPE(particle_list_type), POINTER :: particles
3940 TYPE(pw_env_type), POINTER :: pw_env
3941 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
3942 TYPE(pw_r3d_rs_type) :: stress
3943 TYPE(qs_subsys_type), POINTER :: subsys
3944 TYPE(section_vals_type), POINTER :: dft_section
3945
3946 CALL timeset(routinen, handle)
3947 io_unit = cp_logger_get_default_io_unit(logger)
3948 IF (btest(cp_print_key_should_output(logger%iter_info, input, &
3949 "DFT%PRINT%LOCAL_STRESS_CUBE"), cp_p_file)) THEN
3950 CALL cp_warn(__location__, &
3951 "LOCAL_STRESS_CUBE uses the existing experimental local stress implementation")
3952 dft_section => section_vals_get_subs_vals(input, "DFT")
3953 CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, natom=natom)
3954 gapw = dft_control%qs_control%gapw
3955 gapw_xc = dft_control%qs_control%gapw_xc
3956 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, subsys=subsys)
3957 CALL qs_subsys_get(subsys, particles=particles)
3958 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
3959 CALL auxbas_pw_pool%create_pw(stress)
3960 !
3961 ! use beta=0: kinetic energy density in symmetric form
3962 beta = 0.0_dp
3963 CALL qs_local_stress(qs_env, beta=beta)
3964 CALL get_effective_core_charges(qs_env, zcharge)
3965 !
3966 append_cube = section_get_lval(input, "DFT%PRINT%LOCAL_STRESS_CUBE%APPEND")
3967 IF (append_cube) THEN
3968 my_pos_cube = "APPEND"
3969 ELSE
3970 my_pos_cube = "REWIND"
3971 END IF
3972 mpi_io = .true.
3973 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%LOCAL_STRESS_CUBE", &
3974 extension=".cube", middle_name="local_stress", &
3975 file_position=my_pos_cube, mpi_io=mpi_io)
3976 CALL cp_pw_to_cube(stress, unit_nr, "LOCAL STRESS", particles=particles, zeff=zcharge, &
3977 stride=section_get_ivals(dft_section, "PRINT%LOCAL_STRESS_CUBE%STRIDE"), &
3978 max_file_size_mb=section_get_rval(dft_section, "PRINT%LOCAL_STRESS_CUBE%MAX_FILE_SIZE_MB"), &
3979 mpi_io=mpi_io)
3980 IF (io_unit > 0) THEN
3981 INQUIRE (unit=unit_nr, name=filename)
3982 WRITE (unit=io_unit, fmt="(/,T3,A)") "Write 1/3*Tr(sigma) to cube file"
3983 IF (gapw .OR. gapw_xc) THEN
3984 WRITE (unit=io_unit, fmt="(T3,A,A)") &
3985 "The soft part of the local stress is written to the file: ", trim(adjustl(filename))
3986 ELSE
3987 WRITE (unit=io_unit, fmt="(T3,A,A)") &
3988 "The local stress is written to the file: ", trim(adjustl(filename))
3989 END IF
3990 END IF
3991 CALL cp_print_key_finished_output(unit_nr, logger, input, &
3992 "DFT%PRINT%LOCAL_STRESS_CUBE", mpi_io=mpi_io)
3993 !
3994 CALL auxbas_pw_pool%give_back_pw(stress)
3995 DEALLOCATE (zcharge)
3996 END IF
3997
3998 CALL timestop(handle)
3999
4000 END SUBROUTINE qs_scf_post_local_stress
4001
4002! **************************************************************************************************
4003!> \brief Performs printing of cube files related to the implicit Poisson solver
4004!> \param input input
4005!> \param logger the logger
4006!> \param qs_env the qs_env in which the qs_env lives
4007!> \par History
4008!> 03.2016 refactored from write_mo_free_results [Hossein Bani-Hashemian]
4009!> \author Mohammad Hossein Bani-Hashemian
4010! **************************************************************************************************
4011 SUBROUTINE qs_scf_post_ps_implicit(input, logger, qs_env)
4012 TYPE(section_vals_type), POINTER :: input
4013 TYPE(cp_logger_type), POINTER :: logger
4014 TYPE(qs_environment_type), POINTER :: qs_env
4015
4016 CHARACTER(len=*), PARAMETER :: routinen = 'qs_scf_post_ps_implicit'
4017
4018 CHARACTER(LEN=default_path_length) :: filename, my_pos_cube
4019 INTEGER :: boundary_condition, handle, i, j, &
4020 n_cstr, n_tiles, unit_nr
4021 LOGICAL :: append_cube, do_cstr_charge_cube, do_dielectric_cube, do_dirichlet_bc_cube, &
4022 has_dirichlet_bc, has_implicit_ps, mpi_io, tile_cubes
4023 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: zcharge
4024 TYPE(particle_list_type), POINTER :: particles
4025 TYPE(pw_env_type), POINTER :: pw_env
4026 TYPE(pw_poisson_type), POINTER :: poisson_env
4027 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
4028 TYPE(pw_r3d_rs_type) :: aux_r
4029 TYPE(pw_r3d_rs_type), POINTER :: dirichlet_tile
4030 TYPE(qs_subsys_type), POINTER :: subsys
4031 TYPE(section_vals_type), POINTER :: dft_section
4032
4033 CALL timeset(routinen, handle)
4034
4035 NULLIFY (pw_env, auxbas_pw_pool, dft_section, particles)
4036
4037 dft_section => section_vals_get_subs_vals(input, "DFT")
4038 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, subsys=subsys)
4039 CALL qs_subsys_get(subsys, particles=particles)
4040 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
4041
4042 has_implicit_ps = .false.
4043 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env)
4044 IF (pw_env%poisson_env%parameters%solver == pw_poisson_implicit) has_implicit_ps = .true.
4045
4046 ! Write the dielectric constant into a cube file
4047 do_dielectric_cube = btest(cp_print_key_should_output(logger%iter_info, input, &
4048 "DFT%PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE"), cp_p_file)
4049 IF (has_implicit_ps .AND. do_dielectric_cube) THEN
4050 IF (.NOT. ALLOCATED(zcharge)) CALL get_effective_core_charges(qs_env, zcharge)
4051 append_cube = section_get_lval(input, "DFT%PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE%APPEND")
4052 my_pos_cube = "REWIND"
4053 IF (append_cube) THEN
4054 my_pos_cube = "APPEND"
4055 END IF
4056 mpi_io = .true.
4057 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE", &
4058 extension=".cube", middle_name="DIELECTRIC_CONSTANT", file_position=my_pos_cube, &
4059 mpi_io=mpi_io)
4060 CALL pw_env_get(pw_env, poisson_env=poisson_env, auxbas_pw_pool=auxbas_pw_pool)
4061 CALL auxbas_pw_pool%create_pw(aux_r)
4062
4063 boundary_condition = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
4064 SELECT CASE (boundary_condition)
4066 CALL pw_copy(poisson_env%implicit_env%dielectric%eps, aux_r)
4067 CASE (mixed_bc, neumann_bc)
4068 CALL pw_shrink(pw_env%poisson_env%parameters%ps_implicit_params%neumann_directions, &
4069 pw_env%poisson_env%implicit_env%dct_env%dests_shrink, &
4070 pw_env%poisson_env%implicit_env%dct_env%srcs_shrink, &
4071 pw_env%poisson_env%implicit_env%dct_env%bounds_local_shftd, &
4072 poisson_env%implicit_env%dielectric%eps, aux_r)
4073 END SELECT
4074
4075 CALL cp_pw_to_cube(aux_r, unit_nr, "DIELECTRIC CONSTANT", particles=particles, zeff=zcharge, &
4076 stride=section_get_ivals(dft_section, "PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE%STRIDE"), &
4077 max_file_size_mb=section_get_rval(dft_section, "PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE%MAX_FILE_SIZE_MB"), &
4078 mpi_io=mpi_io)
4079 CALL cp_print_key_finished_output(unit_nr, logger, input, &
4080 "DFT%PRINT%IMPLICIT_PSOLVER%DIELECTRIC_CUBE", mpi_io=mpi_io)
4081
4082 CALL auxbas_pw_pool%give_back_pw(aux_r)
4083 END IF
4084
4085 ! Write Dirichlet constraint charges into a cube file
4086 do_cstr_charge_cube = btest(cp_print_key_should_output(logger%iter_info, input, &
4087 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE"), cp_p_file)
4088
4089 has_dirichlet_bc = .false.
4090 IF (has_implicit_ps) THEN
4091 boundary_condition = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
4092 IF (boundary_condition == mixed_periodic_bc .OR. boundary_condition == mixed_bc) THEN
4093 has_dirichlet_bc = .true.
4094 END IF
4095 END IF
4096
4097 IF (has_implicit_ps .AND. do_cstr_charge_cube .AND. has_dirichlet_bc) THEN
4098 IF (.NOT. ALLOCATED(zcharge)) CALL get_effective_core_charges(qs_env, zcharge)
4099 append_cube = section_get_lval(input, &
4100 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE%APPEND")
4101 my_pos_cube = "REWIND"
4102 IF (append_cube) THEN
4103 my_pos_cube = "APPEND"
4104 END IF
4105 mpi_io = .true.
4106 unit_nr = cp_print_key_unit_nr(logger, input, &
4107 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE", &
4108 extension=".cube", middle_name="dirichlet_cstr_charge", file_position=my_pos_cube, &
4109 mpi_io=mpi_io)
4110 CALL pw_env_get(pw_env, poisson_env=poisson_env, auxbas_pw_pool=auxbas_pw_pool)
4111 CALL auxbas_pw_pool%create_pw(aux_r)
4112
4113 boundary_condition = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
4114 SELECT CASE (boundary_condition)
4115 CASE (mixed_periodic_bc)
4116 CALL pw_copy(poisson_env%implicit_env%cstr_charge, aux_r)
4117 CASE (mixed_bc)
4118 CALL pw_shrink(pw_env%poisson_env%parameters%ps_implicit_params%neumann_directions, &
4119 pw_env%poisson_env%implicit_env%dct_env%dests_shrink, &
4120 pw_env%poisson_env%implicit_env%dct_env%srcs_shrink, &
4121 pw_env%poisson_env%implicit_env%dct_env%bounds_local_shftd, &
4122 poisson_env%implicit_env%cstr_charge, aux_r)
4123 END SELECT
4124
4125 CALL cp_pw_to_cube(aux_r, unit_nr, "DIRICHLET CONSTRAINT CHARGE", particles=particles, zeff=zcharge, &
4126 stride=section_get_ivals(dft_section, "PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE%STRIDE"), &
4127 max_file_size_mb=section_get_rval(dft_section, "PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE%MAX_FILE_SIZE_MB"), &
4128 mpi_io=mpi_io)
4129 CALL cp_print_key_finished_output(unit_nr, logger, input, &
4130 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_CSTR_CHARGE_CUBE", mpi_io=mpi_io)
4131
4132 CALL auxbas_pw_pool%give_back_pw(aux_r)
4133 END IF
4134
4135 ! Write Dirichlet type constranits into cube files
4136 do_dirichlet_bc_cube = btest(cp_print_key_should_output(logger%iter_info, input, &
4137 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE"), cp_p_file)
4138 has_dirichlet_bc = .false.
4139 IF (has_implicit_ps) THEN
4140 boundary_condition = pw_env%poisson_env%parameters%ps_implicit_params%boundary_condition
4141 IF (boundary_condition == mixed_periodic_bc .OR. boundary_condition == mixed_bc) THEN
4142 has_dirichlet_bc = .true.
4143 END IF
4144 END IF
4145
4146 IF (has_implicit_ps .AND. has_dirichlet_bc .AND. do_dirichlet_bc_cube) THEN
4147 IF (.NOT. ALLOCATED(zcharge)) CALL get_effective_core_charges(qs_env, zcharge)
4148 append_cube = section_get_lval(input, "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%APPEND")
4149 my_pos_cube = "REWIND"
4150 IF (append_cube) THEN
4151 my_pos_cube = "APPEND"
4152 END IF
4153 tile_cubes = section_get_lval(input, "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%TILE_CUBES")
4154
4155 CALL pw_env_get(pw_env, poisson_env=poisson_env, auxbas_pw_pool=auxbas_pw_pool)
4156 CALL auxbas_pw_pool%create_pw(aux_r)
4157 CALL pw_zero(aux_r)
4158
4159 IF (tile_cubes) THEN
4160 ! one cube file per tile
4161 n_cstr = SIZE(poisson_env%implicit_env%contacts)
4162 DO j = 1, n_cstr
4163 n_tiles = poisson_env%implicit_env%contacts(j)%dirichlet_bc%n_tiles
4164 DO i = 1, n_tiles
4165 filename = "dirichlet_cstr_"//trim(adjustl(cp_to_string(j)))// &
4166 "_tile_"//trim(adjustl(cp_to_string(i)))
4167 mpi_io = .true.
4168 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE", &
4169 extension=".cube", middle_name=filename, file_position=my_pos_cube, &
4170 mpi_io=mpi_io)
4171
4172 CALL pw_copy(poisson_env%implicit_env%contacts(j)%dirichlet_bc%tiles(i)%tile%tile_pw, aux_r)
4173
4174 CALL cp_pw_to_cube(aux_r, unit_nr, "DIRICHLET TYPE CONSTRAINT", particles=particles, zeff=zcharge, &
4175 stride=section_get_ivals(dft_section, "PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%STRIDE"), &
4176 max_file_size_mb=section_get_rval(dft_section, "PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%MAX_FILE_SIZE_MB"), &
4177 mpi_io=mpi_io)
4178 CALL cp_print_key_finished_output(unit_nr, logger, input, &
4179 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE", mpi_io=mpi_io)
4180 END DO
4181 END DO
4182 ELSE
4183 ! a single cube file
4184 NULLIFY (dirichlet_tile)
4185 ALLOCATE (dirichlet_tile)
4186 CALL auxbas_pw_pool%create_pw(dirichlet_tile)
4187 CALL pw_zero(dirichlet_tile)
4188 mpi_io = .true.
4189 unit_nr = cp_print_key_unit_nr(logger, input, "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE", &
4190 extension=".cube", middle_name="DIRICHLET_CSTR", file_position=my_pos_cube, &
4191 mpi_io=mpi_io)
4192
4193 n_cstr = SIZE(poisson_env%implicit_env%contacts)
4194 DO j = 1, n_cstr
4195 n_tiles = poisson_env%implicit_env%contacts(j)%dirichlet_bc%n_tiles
4196 DO i = 1, n_tiles
4197 CALL pw_copy(poisson_env%implicit_env%contacts(j)%dirichlet_bc%tiles(i)%tile%tile_pw, dirichlet_tile)
4198 CALL pw_axpy(dirichlet_tile, aux_r)
4199 END DO
4200 END DO
4201
4202 CALL cp_pw_to_cube(aux_r, unit_nr, "DIRICHLET TYPE CONSTRAINT", particles=particles, zeff=zcharge, &
4203 stride=section_get_ivals(dft_section, "PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%STRIDE"), &
4204 max_file_size_mb=section_get_rval(dft_section, "PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE%MAX_FILE_SIZE_MB"), &
4205 mpi_io=mpi_io)
4206 CALL cp_print_key_finished_output(unit_nr, logger, input, &
4207 "DFT%PRINT%IMPLICIT_PSOLVER%DIRICHLET_BC_CUBE", mpi_io=mpi_io)
4208 CALL auxbas_pw_pool%give_back_pw(dirichlet_tile)
4209 DEALLOCATE (dirichlet_tile)
4210 END IF
4211
4212 CALL auxbas_pw_pool%give_back_pw(aux_r)
4213 END IF
4214
4215 CALL timestop(handle)
4216
4217 END SUBROUTINE qs_scf_post_ps_implicit
4218
4219!**************************************************************************************************
4220!> \brief write an adjacency (interaction) matrix
4221!> \param qs_env qs environment
4222!> \param input the input
4223!> \author Mohammad Hossein Bani-Hashemian
4224! **************************************************************************************************
4225 SUBROUTINE write_adjacency_matrix(qs_env, input)
4226 TYPE(qs_environment_type), POINTER :: qs_env
4227 TYPE(section_vals_type), POINTER :: input
4228
4229 CHARACTER(len=*), PARAMETER :: routinen = 'write_adjacency_matrix'
4230
4231 INTEGER :: adjm_size, colind, handle, iatom, ikind, &
4232 ind, jatom, jkind, k, natom, nkind, &
4233 output_unit, rowind, unit_nr
4234 INTEGER, ALLOCATABLE, DIMENSION(:) :: interact_adjm
4235 LOGICAL :: do_adjm_write, do_symmetric
4236 TYPE(cp_logger_type), POINTER :: logger
4237 TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: basis_set_list_a, basis_set_list_b
4238 TYPE(gto_basis_set_type), POINTER :: basis_set_a, basis_set_b
4239 TYPE(mp_para_env_type), POINTER :: para_env
4241 DIMENSION(:), POINTER :: nl_iterator
4242 TYPE(neighbor_list_set_p_type), DIMENSION(:), &
4243 POINTER :: nl
4244 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
4245 TYPE(section_vals_type), POINTER :: dft_section
4246
4247 CALL timeset(routinen, handle)
4248
4249 NULLIFY (dft_section)
4250
4251 logger => cp_get_default_logger()
4252 output_unit = cp_logger_get_default_io_unit(logger)
4253
4254 dft_section => section_vals_get_subs_vals(input, "DFT")
4255 do_adjm_write = btest(cp_print_key_should_output(logger%iter_info, dft_section, &
4256 "PRINT%ADJMAT_WRITE"), cp_p_file)
4257
4258 IF (do_adjm_write) THEN
4259 NULLIFY (qs_kind_set, nl_iterator)
4260 NULLIFY (basis_set_list_a, basis_set_list_b, basis_set_a, basis_set_b)
4261
4262 CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, sab_orb=nl, natom=natom, para_env=para_env)
4263
4264 nkind = SIZE(qs_kind_set)
4265 cpassert(SIZE(nl) > 0)
4266 CALL get_neighbor_list_set_p(neighbor_list_sets=nl, symmetric=do_symmetric)
4267 cpassert(do_symmetric)
4268 ALLOCATE (basis_set_list_a(nkind), basis_set_list_b(nkind))
4269 CALL basis_set_list_setup(basis_set_list_a, "ORB", qs_kind_set)
4270 CALL basis_set_list_setup(basis_set_list_b, "ORB", qs_kind_set)
4271
4272 adjm_size = ((natom + 1)*natom)/2
4273 ALLOCATE (interact_adjm(4*adjm_size))
4274 interact_adjm = 0
4275
4276 NULLIFY (nl_iterator)
4277 CALL neighbor_list_iterator_create(nl_iterator, nl)
4278 DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
4279 CALL get_iterator_info(nl_iterator, &
4280 ikind=ikind, jkind=jkind, &
4281 iatom=iatom, jatom=jatom)
4282
4283 basis_set_a => basis_set_list_a(ikind)%gto_basis_set
4284 IF (.NOT. ASSOCIATED(basis_set_a)) cycle
4285 basis_set_b => basis_set_list_b(jkind)%gto_basis_set
4286 IF (.NOT. ASSOCIATED(basis_set_b)) cycle
4287
4288 ! move everything to the upper triangular part
4289 IF (iatom <= jatom) THEN
4290 rowind = iatom
4291 colind = jatom
4292 ELSE
4293 rowind = jatom
4294 colind = iatom
4295 ! swap the kinds too
4296 ikind = ikind + jkind
4297 jkind = ikind - jkind
4298 ikind = ikind - jkind
4299 END IF
4300
4301 ! indexing upper triangular matrix
4302 ind = adjm_size - (natom - rowind + 1)*((natom - rowind + 1) + 1)/2 + colind - rowind + 1
4303 ! convert the upper triangular matrix into a adjm_size x 4 matrix
4304 ! columns are: iatom, jatom, ikind, jkind
4305 interact_adjm((ind - 1)*4 + 1) = rowind
4306 interact_adjm((ind - 1)*4 + 2) = colind
4307 interact_adjm((ind - 1)*4 + 3) = ikind
4308 interact_adjm((ind - 1)*4 + 4) = jkind
4309 END DO
4310
4311 CALL para_env%sum(interact_adjm)
4312
4313 unit_nr = cp_print_key_unit_nr(logger, dft_section, "PRINT%ADJMAT_WRITE", &
4314 extension=".adjmat", file_form="FORMATTED", &
4315 file_status="REPLACE")
4316 IF (unit_nr > 0) THEN
4317 WRITE (unit_nr, "(1A,2X,1A,5X,1A,4X,A5,3X,A5)") "#", "iatom", "jatom", "ikind", "jkind"
4318 DO k = 1, 4*adjm_size, 4
4319 ! print only the interacting atoms
4320 IF (interact_adjm(k) > 0 .AND. interact_adjm(k + 1) > 0) THEN
4321 WRITE (unit_nr, "(I8,2X,I8,3X,I6,2X,I6)") interact_adjm(k:k + 3)
4322 END IF
4323 END DO
4324 END IF
4325
4326 CALL cp_print_key_finished_output(unit_nr, logger, dft_section, "PRINT%ADJMAT_WRITE")
4327
4328 CALL neighbor_list_iterator_release(nl_iterator)
4329 DEALLOCATE (basis_set_list_a, basis_set_list_b)
4330 END IF
4331
4332 CALL timestop(handle)
4333
4334 END SUBROUTINE write_adjacency_matrix
4335
4336! **************************************************************************************************
4337!> \brief Updates Hartree potential with MP2 density. Important for REPEAT charges
4338!> \param rho ...
4339!> \param qs_env ...
4340!> \author Vladimir Rybkin
4341! **************************************************************************************************
4342 SUBROUTINE update_hartree_with_mp2(rho, qs_env)
4343 TYPE(qs_rho_type), POINTER :: rho
4344 TYPE(qs_environment_type), POINTER :: qs_env
4345
4346 LOGICAL :: use_virial
4347 TYPE(pw_c1d_gs_type) :: rho_tot_gspace, v_hartree_gspace
4348 TYPE(pw_c1d_gs_type), POINTER :: rho_core
4349 TYPE(pw_env_type), POINTER :: pw_env
4350 TYPE(pw_poisson_type), POINTER :: poisson_env
4351 TYPE(pw_pool_type), POINTER :: auxbas_pw_pool
4352 TYPE(pw_r3d_rs_type), POINTER :: v_hartree_rspace
4353 TYPE(qs_energy_type), POINTER :: energy
4354 TYPE(virial_type), POINTER :: virial
4355
4356 NULLIFY (auxbas_pw_pool, pw_env, poisson_env, energy, rho_core, v_hartree_rspace, virial)
4357 CALL get_qs_env(qs_env, pw_env=pw_env, energy=energy, &
4358 rho_core=rho_core, virial=virial, &
4359 v_hartree_rspace=v_hartree_rspace)
4360
4361 use_virial = virial%pv_availability .AND. (.NOT. virial%pv_numer)
4362
4363 IF (.NOT. use_virial) THEN
4364
4365 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, &
4366 poisson_env=poisson_env)
4367 CALL auxbas_pw_pool%create_pw(v_hartree_gspace)
4368 CALL auxbas_pw_pool%create_pw(rho_tot_gspace)
4369
4370 CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho)
4371 CALL pw_poisson_solve(poisson_env, rho_tot_gspace, energy%hartree, &
4372 v_hartree_gspace, rho_core=rho_core)
4373
4374 CALL pw_transfer(v_hartree_gspace, v_hartree_rspace)
4375 CALL pw_scale(v_hartree_rspace, v_hartree_rspace%pw_grid%dvol)
4376
4377 CALL auxbas_pw_pool%give_back_pw(v_hartree_gspace)
4378 CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace)
4379 END IF
4380
4381 END SUBROUTINE update_hartree_with_mp2
4382
4383END MODULE qs_scf_post_gpw
static double norm_factor(double alpha, int L)
Types and set/get functions for auxiliary density matrix methods.
Definition admm_types.F:15
Contains methods used in the context of density fitting.
Definition admm_utils.F:15
subroutine, public admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_matrix)
...
Definition admm_utils.F:127
subroutine, public admm_correct_for_eigenvalues(ispin, admm_env, ks_matrix)
...
Definition admm_utils.F:53
subroutine, public sg_overlap(smat, l, pa, pb)
...
calculate the orbitals for a given atomic kind type
subroutine, public calculate_atomic_density(density, atomic_kind, qs_kind, ngto, iunit, optbasis, allelectron, confine)
...
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
Writer for CASINO gwfn.data files.
subroutine, public write_casino(qs_env, casino_section)
Write a CASINO gwfn.data file from the converged GPW/GAPW wavefunction.
Handles all functions related to the CELL.
Definition cell_types.F:15
Calculation of the non-local pseudopotential contribution to the core Hamiltonian <a|V(non-local)|b> ...
subroutine, public build_com_mom_nl(qs_kind_set, sab_all, sap_ppnl, eps_ppnl, particle_set, cell, matrix_rv, matrix_rxrv, matrix_rrv, matrix_rvr, matrix_rrv_vrr, matrix_r_rxvr, matrix_rxvr_r, matrix_r_doublecom, pseudoatom, ref_point)
Calculate [r,Vnl] (matrix_rv), r x [r,Vnl] (matrix_rxrv) or [rr,Vnl] (matrix_rrv) in AO basis....
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
methods related to the blacs parallel environment
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
real(kind=dp) function, public dbcsr_checksum(matrix, pos)
Calculates the checksum of a DBCSR matrix.
DBCSR operations in CP2K.
subroutine, public copy_dbcsr_to_fm(matrix, fm, plan, check_plan)
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, cartesian_basis)
...
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:262
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_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
creates a new full matrix with the given structure
subroutine, public cp_fm_init_random(matrix, ncol, start_col)
fills a matrix with random numbers
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...
subroutine, public cp_openpmd_close_iterations()
integer function, public cp_openpmd_print_key_unit_nr(logger, basis_section, print_key_path, middle_name, ignore_should_output, mpi_io, fout, openpmd_basename, openpmd_unit_dimension, openpmd_unit_si, sim_time)
...
subroutine, public cp_openpmd_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, mpi_io)
should be called after you finish working with a unit obtained with cp_openpmd_print_key_unit_nr,...
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
character(len=default_string_length) function, public cp_iter_string(iter_info, print_key, for_file)
returns the iteration string, a string that is useful to create unique filenames (once you trim it)
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
A wrapper around pw_to_cube() which accepts particle_list_type.
subroutine, public cp_pw_to_cube(pw, unit_nr, title, particles, zeff, stride, max_file_size_mb, zero_tails, silent, mpi_io)
...
A wrapper around pw_to_openpmd() which accepts particle_list_type.
subroutine, public cp_pw_to_openpmd(pw, unit_nr, title, particles, zeff, stride, zero_tails, silent, mpi_io)
...
set of type/routines to handle the storage of results in force_envs
set of type/routines to handle the storage of results in force_envs
the type I Discrete Cosine Transform (DCT-I)
Definition dct.F:16
subroutine, public pw_shrink(neumann_directions, dests_shrink, srcs_shrink, bounds_local_shftd, pw_in, pw_shrinked)
shrinks an evenly symmetric pw_r3d_rs_type data to a pw_r3d_rs_type data that is 8 times smaller (the...
Definition dct.F:700
Calculate Energy Decomposition analysis.
Definition ed_analysis.F:14
subroutine, public edmf_analysis(qs_env, input_section, unit_nr)
...
Calculation of charge equilibration method.
Definition eeq_method.F:12
subroutine, public eeq_print(qs_env, iounit, print_level, ext)
...
Definition eeq_method.F:135
Definition and initialisation of the et_coupling data type.
subroutine, public set_et_coupling_type(et_coupling, et_mo_coeff, rest_mat)
...
GAPW reciprocal-space reconstruction and its discrete adjoint.
subroutine, public calculate_rhotot_elec_gspace(qs_env, auxbas_pw_pool, rhotot_elec_gspace, q_max, rho_hard, rho_soft, fsign, compute_tau, rho_source, allow_nonorthorhombic)
The total electronic density in reciprocal space (g-space) is calculated.
RI-methods for HFX.
Definition hfx_ri.F:12
subroutine, public print_ri_hfx(ri_data, qs_env)
Print RI-HFX quantities, as required by the PRINT subsection.
Definition hfx_ri.F:3627
Calculate Hirshfeld charges and related functions.
subroutine, public comp_hirshfeld_charges(qs_env, hirshfeld_env, charges)
...
subroutine, public create_shape_function(hirshfeld_env, qs_kind_set, atomic_kind_set, radius, radii_list)
creates kind specific shape functions for Hirshfeld charges
subroutine, public write_hirshfeld_charges(charges, hirshfeld_env, particle_set, qs_kind_set, unit_nr)
...
subroutine, public comp_hirshfeld_i_charges(qs_env, hirshfeld_env, charges, ounit)
...
subroutine, public save_hirshfeld_charges(charges, particle_set, qs_kind_set, qs_env)
saves the Hirshfeld charges to the results structure
The types needed for the calculation of Hirshfeld charges and related functions.
subroutine, public create_hirshfeld_type(hirshfeld_env)
...
subroutine, public set_hirshfeld_info(hirshfeld_env, shape_function_type, iterative, ref_charge, fnorm, radius_type, use_bohr)
Set values of a Hirshfeld env.
subroutine, public release_hirshfeld_type(hirshfeld_env)
...
Calculate intrinsic atomic orbitals and analyze wavefunctions.
subroutine, public iao_wfn_analysis(qs_env, iao_env, unit_nr, c_iao_coef, mos, bond_centers)
...
Calculate ntrinsic atomic orbitals and analyze wavefunctions.
Definition iao_types.F:14
subroutine, public iao_read_input(iao_env, iao_section, cell)
...
Definition iao_types.F:148
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 ot_precond_full_all_covariant
integer, parameter, public do_loc_lumo
integer, parameter, public moments_format_trajectory
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
K-point MO wavefunction dump to TEXT file for post-processing (PDOS, etc.).
subroutine, public write_kpoint_mo_data(qs_env, print_section)
Write k-point resolved MO data to formatted text file.
Types and basic routines needed for a kpoint calculation.
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition list.F:24
Routines for the calculation of moments from Wannier functions.
subroutine, public calculate_kg_moments(qs_env, unit_nr, max_moment, magnetic, vel_reprs, com_nl)
Calculates multipole moments per molecule from the Kim-Gordon AO density matrix.
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, cell, unoccupied_orbs, unoccupied_evals, qs_env, calc_energies)
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 a_bohr
Definition physcon.F:136
real(kind=dp), parameter, public evolt
Definition physcon.F:183
real(kind=dp), parameter, public angstrom
Definition physcon.F:144
real(kind=dp), parameter, public debye
Definition physcon.F:201
Provide various population analyses and print the requested output information.
subroutine, public lowdin_population_analysis(qs_env, output_unit, print_level)
Perform a Lowdin population analysis based on a symmetric orthogonalisation of the density matrix usi...
subroutine, public mulliken_population_analysis(qs_env, output_unit, print_level)
Perform a Mulliken population analysis.
types of preconditioners
computes preconditioners, and implements methods to apply them currently used in qs_ot
Types containing essential information for running implicit (iterative) Poisson solver.
integer, parameter, public neumann_bc
integer, parameter, public mixed_bc
integer, parameter, public mixed_periodic_bc
integer, parameter, public periodic_bc
container for various plainwaves related things
subroutine, public pw_env_get(pw_env, pw_pools, cube_info, gridlevel_info, auxbas_pw_pool, auxbas_grid, auxbas_rs_desc, auxbas_rs_grid, rs_descs, rs_grids, xc_pw_pool, vdw_pw_pool, poisson_env, interp_section)
returns the various attributes of the pw env
This module defines the grid data type and some basic operations on it.
Definition pw_grids.F:36
subroutine, public get_pw_grid_info(pw_grid, id_nr, mode, vol, dvol, npts, ngpts, ngpts_cut, dr, cutoff, orthorhombic, gvectors, gsquare)
Access to information stored in the pw_grid_type.
Definition pw_grids.F:185
subroutine, public pw_derive(pw, n)
Calculate the derivative of a plane wave vector.
functions related to the poisson solver on regular grids
integer, parameter, public pw_poisson_implicit
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Write wfx file, works as interface to chargemol and multiwfn.
subroutine, public write_wfx(qs_env, dft_section)
...
container for information about total charges on the grids
Calculate the plane wave density by collocating the primitive Gaussian functions (pgf).
subroutine, public calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, pw_env, basis_type)
maps a given wavefunction on the grid
Calculation of the energies concerning the core charge distribution.
Utilities for broadened DOS and PDOS output.
subroutine, public get_dos_pdos_flags(dos_section, do_dos_output, do_projected_dos, do_pdos, do_curve)
Resolve projected-DOS requests from a DOS print section.
Calculation and writing of density of states.
Definition qs_dos.F:14
subroutine, public calculate_dos_kp(qs_env, dft_section, write_curve_output)
Compute and write density of states (kpoints).
Definition qs_dos.F:364
subroutine, public calculate_dos(mos, dft_section, unoccupied_evals, smearing_enabled, write_curve_output)
Compute and write density of states.
Definition qs_dos.F:67
Calculates electric field gradients H.M. Petrili, P.E. Blochl, P. Blaha, K. Schwarz,...
subroutine, public qs_efg_calc(qs_env)
...
Does all kind of post scf calculations for GPW/GAPW.
subroutine, public qs_elf_calc(qs_env, elf_r, rho_cutoff)
...
Does all kind of post scf calculations for GPW/GAPW.
subroutine, public energy_windows(qs_env)
...
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_vhxc, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
subroutine, public set_qs_env(qs_env, super_cell, mos, qmmm, qmmm_periodic, mimic, ewald_env, ewald_pw, mpools, rho_external, external_vxc, mask, scf_control, rel_control, qs_charges, ks_env, ks_qmmm_env, wf_history, scf_env, active_space, input, oce, rho_atom_set, rho0_atom_set, rho0_mpole, run_rtp, rtp, rhoz_set, rhoz_tot, ecoul_1c, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, efield, rhoz_cneo_set, linres_control, xas_env, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, ls_scf_env, do_transport, transport_env, lri_env, lri_density, exstate_env, ec_env, dispersion_env, harris_env, gcp_env, mp2_env, bs_env, kg_env, force, kpoints, wanniercentres, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Set the QUICKSTEP environment.
Calculates hyperfine values.
Definition qs_epr_hyp.F:15
subroutine, public qs_epr_hyp_calc(qs_env)
...
Definition qs_epr_hyp.F:75
Fractional occupation number weighted density (Grimme and Hansen).
Definition qs_fod.F:12
subroutine, public qs_scf_post_fod(input, logger, qs_env, output_unit)
Print the orbital FOD sum and, optionally, its real-space density.
Definition qs_fod.F:120
Some utility functions for the calculation of integrals.
subroutine, public basis_set_list_setup(basis_set_list, basis_type, qs_kind_set)
Set up an easy accessible list of the basis sets for all kinds.
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, cneo_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, hund_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, proj_shell_charge, lr_atom, do_mtlr, u_j_loop, ao_coef, init_u_ramping_each_scf, reltmat, ghost, monovalent, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
routines that build the Kohn-Sham matrix (i.e calculate the coulomb and xc parts
subroutine, public qs_ks_update_qs_env(qs_env, calculate_forces, just_energy, print_active)
updates the Kohn Sham matrix of the given qs_env (facility method)
subroutine, public calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho, skip_nuclear_density)
...
subroutine, public qs_ks_did_change(ks_env, s_mstruct_changed, rho_changed, potential_changed, full_reset)
tells that some of the things relevant to the ks calculation did change. has to be called when change...
Finite-volume Kubo-Greenwood transport from converged Quickstep matrices.
subroutine, public qs_scf_post_kubo_transport(qs_env)
Compute and print the finite-volume Kubo-Greenwood conductivity tensor.
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:184
collects routines that perform operations directly related to MOs
subroutine, public make_mo_eig(mos, nspins, ks_rmpv, scf_control, mo_derivs, admm_env, hairy_probes, probe)
Calculate KS eigenvalues starting from OF MOS.
Set occupation of molecular orbitals.
Definition and initialisation of the mo data type.
Definition qs_mo_types.F:22
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count, cmo_coeff)
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_kpoints(qs_env, nmoments, reference, ref_point, max_nmo, unit_number)
Calculate and print dipole moment elements d_nm(k) for k-point calculations.
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)
...
subroutine, public build_lin_mom_matrix(qs_env, matrix, minimum_image)
Calculation of the linear momentum matrix <mu|∂|nu> over Cartesian Gaussian functions.
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_kp(qs_env, dft_section, pdos_print_key, write_pdos, write_pdos_curve)
Compute and write broadened projected density of states for k-point calculations.
Definition qs_pdos.F:1073
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, unoccupied_orbs, unoccupied_evals, pdos_print_key, write_pdos, write_pdos_curve)
Compute and write projected density of states.
Definition qs_pdos.F:155
Finite or periodic quadratic pseudospectrum analysis after SCF.
subroutine, public qs_scf_post_quadratic(qs_env)
Evaluate scans of quadratic gaps and localized joint approximate eigenstates.
provides a resp fit for gas phase systems
Definition qs_resp.F:16
subroutine, public resp_fit(qs_env)
performs resp fit and generates RESP charges
Definition qs_resp.F:132
subroutine, public get_rho0_mpole(rho0_mpole, g0_h, vg0_h, iat, ikind, lmax_0, l0_ikind, mp_gau_ikind, mp_rho, norm_g0l_h, qlm_gg, qlm_car, qlm_tot, zet0_h, igrid_zet0_s, rpgf0_h, rpgf0_s, max_rpgf0_s, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs)
...
methods of the rho structure (defined in qs_rho_types)
subroutine, public qs_rho_update_rho(rho_struct, qs_env, rho_xc_external, local_rho_set, task_list_external, task_list_external_soft, pw_env_external, para_env_external)
updates rho_r and rho_g to the rhorho_ao. if use_kinetic_energy_density also computes tau_r and tau_g...
superstucture that hold various representations of the density and keeps track of which ones are vali...
subroutine, public qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
returns info about the density described by this object. If some representation is not available an e...
Functions to print the KS and S matrix in the CSR format to file.
subroutine, public write_s_matrix_csr(qs_env, input)
writing the overlap matrix in csr format into a file
subroutine, public write_ks_matrix_csr(qs_env, input)
writing the KS matrix in csr format into a file
subroutine, public write_p_matrix_csr(qs_env, input)
writing the density matrix in csr format into a file
subroutine, public write_hcore_matrix_csr(qs_env, input)
writing the core Hamiltonian 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 their eigenvalues for all spin channels.
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 get_effective_core_charges(qs_env, zcharge)
Collects the effective core charge for every atom in a QS environment.
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
Post-SCF finite-system spectral localizers and analytic AO position export.
subroutine, public qs_scf_post_localizer(qs_env)
Export finite AO positions and optionally evaluate localizers after SCF.
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:746
The module to read/write TREX IO files for interfacing CP2K with other programs.
subroutine, public write_trexio(qs_env, trexio_section, energy_derivative)
Write a trexio file.
Interface for Voronoi Integration and output of BQB files.
subroutine, public entry_voronoi_or_bqb(do_voro, do_bqb, input_voro, input_bqb, unit_voro, qs_env, rspace_pw)
Does a Voronoi integration of density or stores the density to compressed BQB format.
subroutine, public xray_diffraction_spectrum(qs_env, unit_number, q_max)
Calculate the coherent X-ray diffraction spectrum using the total electronic density in reciprocal sp...
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:60
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...
contains arbitrary information which need to be stored
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 ...
Container for information about total charges on the grids.
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.