!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!

! **************************************************************************************************
!> \brief Definition and initialisation of the mo data type.
!> \par History
!>      - adapted to the new QS environment data structure (02.04.2002,MK)
!>      - set_mo_occupation added (17.04.02,MK)
!>      - correct_mo_eigenvalues added (18.04.02,MK)
!>      - calculate_density_matrix moved from qs_scf to here (22.04.02,MK)
!>      - mo_set_p_type added (23.04.02,MK)
!>      - PRIVATE attribute set for TYPE mo_set_type (23.04.02,MK)
!>      - started conversion to LSD (1.2003, Joost VandeVondele)
!>      - Split of from qs_mo_types (07.2014, JGH)
!> \author Matthias Krack (09.05.2001,MK)
! **************************************************************************************************
MODULE qs_mo_io

   USE atomic_kind_types,               ONLY: atomic_kind_type,&
                                              get_atomic_kind,&
                                              get_atomic_kind_set
   USE basis_set_types,                 ONLY: get_gto_basis_set,&
                                              gto_basis_set_type
   USE cp_dbcsr_api,                    ONLY: dbcsr_binary_write,&
                                              dbcsr_checksum,&
                                              dbcsr_create,&
                                              dbcsr_p_type,&
                                              dbcsr_release,&
                                              dbcsr_type
   USE cp_dbcsr_operations,             ONLY: copy_dbcsr_to_fm,&
                                              copy_fm_to_dbcsr
   USE cp_files,                        ONLY: close_file,&
                                              open_file
   USE cp_fm_types,                     ONLY: cp_fm_get_info,&
                                              cp_fm_get_submatrix,&
                                              cp_fm_set_all,&
                                              cp_fm_set_submatrix,&
                                              cp_fm_to_fm,&
                                              cp_fm_type,&
                                              cp_fm_write_unformatted
   USE cp_log_handling,                 ONLY: cp_get_default_logger,&
                                              cp_logger_get_default_unit_nr,&
                                              cp_logger_type,&
                                              cp_to_string
   USE cp_output_handling,              ONLY: cp_p_file,&
                                              cp_print_key_finished_output,&
                                              cp_print_key_generate_filename,&
                                              cp_print_key_should_output,&
                                              cp_print_key_unit_nr
   USE input_section_types,             ONLY: section_vals_get_subs_vals,&
                                              section_vals_type,&
                                              section_vals_val_get
   USE kahan_sum,                       ONLY: accurate_sum
   USE kinds,                           ONLY: default_path_length,&
                                              default_string_length,&
                                              dp
   USE message_passing,                 ONLY: mp_para_env_type
   USE orbital_pointers,                ONLY: indco,&
                                              nco,&
                                              nso
   USE orbital_symbols,                 ONLY: cgf_symbol,&
                                              sgf_symbol
   USE orbital_transformation_matrices, ONLY: orbtramat
   USE particle_types,                  ONLY: particle_type
   USE physcon,                         ONLY: evolt
   USE qs_density_matrices,             ONLY: calculate_density_matrix
   USE qs_dftb_types,                   ONLY: qs_dftb_atom_type
   USE qs_dftb_utils,                   ONLY: get_dftb_atom_param
   USE qs_kind_types,                   ONLY: get_qs_kind,&
                                              get_qs_kind_set,&
                                              qs_kind_type
   USE qs_mo_occupation,                ONLY: set_mo_occupation
   USE qs_mo_types,                     ONLY: get_mo_set,&
                                              mo_set_type
#include "./base/base_uses.f90"

   IMPLICIT NONE

   PRIVATE

   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_mo_io'

   PUBLIC :: wfn_restart_file_name, &
             write_rt_mos_to_restart, &
             read_rt_mos_from_restart, &
             write_dm_binary_restart, &
             write_mo_set_to_output_unit, &
             write_mo_set_to_restart, &
             read_mo_set_from_restart, &
             read_mos_restart_low, &
             write_mo_set_low

CONTAINS

! **************************************************************************************************
!> \brief ...
!> \param mo_array ...
!> \param particle_set ...
!> \param dft_section ...
!> \param qs_kind_set ...
! **************************************************************************************************
   SUBROUTINE write_mo_set_to_restart(mo_array, particle_set, dft_section, qs_kind_set)

      TYPE(mo_set_type), DIMENSION(:), INTENT(IN)        :: mo_array
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(section_vals_type), POINTER                   :: dft_section
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set

      CHARACTER(LEN=*), PARAMETER :: routineN = 'write_mo_set_to_restart'
      CHARACTER(LEN=30), DIMENSION(2), PARAMETER :: &
         keys = (/"SCF%PRINT%RESTART_HISTORY", "SCF%PRINT%RESTART        "/)

      INTEGER                                            :: handle, ikey, ires, ispin
      TYPE(cp_logger_type), POINTER                      :: logger

      CALL timeset(routineN, handle)
      logger => cp_get_default_logger()

      IF (BTEST(cp_print_key_should_output(logger%iter_info, &
                                           dft_section, keys(1)), cp_p_file) .OR. &
          BTEST(cp_print_key_should_output(logger%iter_info, &
                                           dft_section, keys(2)), cp_p_file)) THEN

         IF (mo_array(1)%use_mo_coeff_b) THEN
            ! we are using the dbcsr mo_coeff
            ! we copy it to the fm for anycase
            DO ispin = 1, SIZE(mo_array)
               IF (.NOT. ASSOCIATED(mo_array(ispin)%mo_coeff_b)) THEN
                  CPASSERT(.FALSE.)
               END IF
               CALL copy_dbcsr_to_fm(mo_array(ispin)%mo_coeff_b, &
                                     mo_array(ispin)%mo_coeff) !fm->dbcsr
            END DO
         END IF

         DO ikey = 1, SIZE(keys)

            IF (BTEST(cp_print_key_should_output(logger%iter_info, &
                                                 dft_section, keys(ikey)), cp_p_file)) THEN

               ires = cp_print_key_unit_nr(logger, dft_section, keys(ikey), &
                                           extension=".wfn", file_status="REPLACE", file_action="WRITE", &
                                           do_backup=.TRUE., file_form="UNFORMATTED")

               CALL write_mo_set_low(mo_array, particle_set=particle_set, &
                                     qs_kind_set=qs_kind_set, ires=ires)

               CALL cp_print_key_finished_output(ires, logger, dft_section, TRIM(keys(ikey)))
            END IF
         END DO
      END IF

      CALL timestop(handle)

   END SUBROUTINE write_mo_set_to_restart

! **************************************************************************************************
!> \brief calculates density matrix from mo set and writes the density matrix
!>        into a binary restart file
!> \param mo_array mos
!> \param dft_section dft input section
!> \param tmpl_matrix template dbcsr matrix
!> \author Mohammad Hossein Bani-Hashemian
! **************************************************************************************************
   SUBROUTINE write_dm_binary_restart(mo_array, dft_section, tmpl_matrix)

      TYPE(mo_set_type), DIMENSION(:), INTENT(IN)        :: mo_array
      TYPE(section_vals_type), POINTER                   :: dft_section
      TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: tmpl_matrix

      CHARACTER(LEN=*), PARAMETER :: routineN = 'write_dm_binary_restart'

      CHARACTER(LEN=default_path_length)                 :: file_name, project_name
      INTEGER                                            :: handle, ispin, unit_nr
      LOGICAL                                            :: do_dm_restart
      REAL(KIND=dp)                                      :: cs_pos
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(dbcsr_type), POINTER                          :: matrix_p_tmp

      CALL timeset(routineN, handle)
      logger => cp_get_default_logger()
      IF (logger%para_env%is_source()) THEN
         unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
      ELSE
         unit_nr = -1
      END IF

      project_name = logger%iter_info%project_name
      CALL section_vals_val_get(dft_section, "SCF%PRINT%DM_RESTART_WRITE", l_val=do_dm_restart)
      NULLIFY (matrix_p_tmp)

      IF (do_dm_restart) THEN
         ALLOCATE (matrix_p_tmp)
         DO ispin = 1, SIZE(mo_array)
            CALL dbcsr_create(matrix_p_tmp, template=tmpl_matrix(ispin)%matrix, name="DM RESTART")

            IF (.NOT. ASSOCIATED(mo_array(ispin)%mo_coeff_b)) CPABORT("mo_coeff_b NOT ASSOCIATED")

            CALL copy_fm_to_dbcsr(mo_array(ispin)%mo_coeff, mo_array(ispin)%mo_coeff_b)
            CALL calculate_density_matrix(mo_array(ispin), matrix_p_tmp, &
                                          use_dbcsr=.TRUE., retain_sparsity=.FALSE.)

            WRITE (file_name, '(A,I0,A)') TRIM(project_name)//"_SCF_DM_SPIN_", ispin, "_RESTART.dm"
            cs_pos = dbcsr_checksum(matrix_p_tmp, pos=.TRUE.)
            IF (unit_nr > 0) THEN
               WRITE (unit_nr, '(T2,A,E20.8)') "Writing restart DM "//TRIM(file_name)//" with checksum: ", cs_pos
            END IF
            CALL dbcsr_binary_write(matrix_p_tmp, file_name)

            CALL dbcsr_release(matrix_p_tmp)
         END DO
         DEALLOCATE (matrix_p_tmp)
      END IF

      CALL timestop(handle)

   END SUBROUTINE write_dm_binary_restart

! **************************************************************************************************
!> \brief ...
!> \param mo_array ...
!> \param rt_mos ...
!> \param particle_set ...
!> \param dft_section ...
!> \param qs_kind_set ...
! **************************************************************************************************
   SUBROUTINE write_rt_mos_to_restart(mo_array, rt_mos, particle_set, dft_section, &
                                      qs_kind_set)

      TYPE(mo_set_type), DIMENSION(:), INTENT(IN)        :: mo_array
      TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: rt_mos
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(section_vals_type), POINTER                   :: dft_section
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set

      CHARACTER(LEN=*), PARAMETER :: routineN = 'write_rt_mos_to_restart'
      CHARACTER(LEN=43), DIMENSION(2), PARAMETER :: keys = (/ &
         "REAL_TIME_PROPAGATION%PRINT%RESTART_HISTORY", &
         "REAL_TIME_PROPAGATION%PRINT%RESTART        "/)

      INTEGER                                            :: handle, ikey, ires
      TYPE(cp_logger_type), POINTER                      :: logger

      CALL timeset(routineN, handle)
      logger => cp_get_default_logger()

      IF (BTEST(cp_print_key_should_output(logger%iter_info, &
                                           dft_section, keys(1)), cp_p_file) .OR. &
          BTEST(cp_print_key_should_output(logger%iter_info, &
                                           dft_section, keys(2)), cp_p_file)) THEN

         DO ikey = 1, SIZE(keys)

            IF (BTEST(cp_print_key_should_output(logger%iter_info, &
                                                 dft_section, keys(ikey)), cp_p_file)) THEN

               ires = cp_print_key_unit_nr(logger, dft_section, keys(ikey), &
                                           extension=".rtpwfn", file_status="REPLACE", file_action="WRITE", &
                                           do_backup=.TRUE., file_form="UNFORMATTED")

               CALL write_mo_set_low(mo_array, rt_mos=rt_mos, qs_kind_set=qs_kind_set, &
                                     particle_set=particle_set, ires=ires)
               CALL cp_print_key_finished_output(ires, logger, dft_section, TRIM(keys(ikey)))
            END IF
         END DO
      END IF

      CALL timestop(handle)

   END SUBROUTINE write_rt_mos_to_restart

! **************************************************************************************************
!> \brief ...
!> \param mo_array ...
!> \param qs_kind_set ...
!> \param particle_set ...
!> \param ires ...
!> \param rt_mos ...
! **************************************************************************************************
   SUBROUTINE write_mo_set_low(mo_array, qs_kind_set, particle_set, ires, rt_mos)

      TYPE(mo_set_type), DIMENSION(:), INTENT(IN)        :: mo_array
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      INTEGER                                            :: ires
      TYPE(cp_fm_type), DIMENSION(:), INTENT(IN), &
         OPTIONAL                                        :: rt_mos

      CHARACTER(LEN=*), PARAMETER                        :: routineN = 'write_mo_set_low'

      INTEGER                                            :: handle, iatom, ikind, imat, iset, &
                                                            ishell, ispin, lmax, lshell, &
                                                            max_block, nao, natom, nmo, nset, &
                                                            nset_max, nshell_max, nspin
      INTEGER, DIMENSION(:), POINTER                     :: nset_info, nshell
      INTEGER, DIMENSION(:, :), POINTER                  :: l, nshell_info
      INTEGER, DIMENSION(:, :, :), POINTER               :: nso_info
      TYPE(gto_basis_set_type), POINTER                  :: orb_basis_set
      TYPE(qs_dftb_atom_type), POINTER                   :: dftb_parameter

      CALL timeset(routineN, handle)
      nspin = SIZE(mo_array)
      nao = mo_array(1)%nao

      IF (ires > 0) THEN
         !     *** create some info about the basis set first ***
         natom = SIZE(particle_set, 1)
         nset_max = 0
         nshell_max = 0

         DO iatom = 1, natom
            NULLIFY (orb_basis_set, dftb_parameter)
            CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
            CALL get_qs_kind(qs_kind_set(ikind), &
                             basis_set=orb_basis_set, dftb_parameter=dftb_parameter)
            IF (ASSOCIATED(orb_basis_set)) THEN
               CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
                                      nset=nset, &
                                      nshell=nshell, &
                                      l=l)
               nset_max = MAX(nset_max, nset)
               DO iset = 1, nset
                  nshell_max = MAX(nshell_max, nshell(iset))
               END DO
            ELSEIF (ASSOCIATED(dftb_parameter)) THEN
               CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
               nset_max = MAX(nset_max, 1)
               nshell_max = MAX(nshell_max, lmax + 1)
            ELSE
               ! We assume here an atom without a basis set
               ! CPABORT("Unknown basis type. ")
            END IF
         END DO

         ALLOCATE (nso_info(nshell_max, nset_max, natom))
         nso_info(:, :, :) = 0

         ALLOCATE (nshell_info(nset_max, natom))
         nshell_info(:, :) = 0

         ALLOCATE (nset_info(natom))
         nset_info(:) = 0

         DO iatom = 1, natom
            NULLIFY (orb_basis_set, dftb_parameter)
            CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
            CALL get_qs_kind(qs_kind_set(ikind), &
                             basis_set=orb_basis_set, dftb_parameter=dftb_parameter)
            IF (ASSOCIATED(orb_basis_set)) THEN
               CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
                                      nset=nset, &
                                      nshell=nshell, &
                                      l=l)
               nset_info(iatom) = nset
               DO iset = 1, nset
                  nshell_info(iset, iatom) = nshell(iset)
                  DO ishell = 1, nshell(iset)
                     lshell = l(ishell, iset)
                     nso_info(ishell, iset, iatom) = nso(lshell)
                  END DO
               END DO
            ELSEIF (ASSOCIATED(dftb_parameter)) THEN
               CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
               nset_info(iatom) = 1
               nshell_info(1, iatom) = lmax + 1
               DO ishell = 1, lmax + 1
                  lshell = ishell - 1
                  nso_info(ishell, 1, iatom) = nso(lshell)
               END DO
            ELSE
               ! We assume here an atom without a basis set
               ! CPABORT("Unknown basis type. ")
            END IF
         END DO

         WRITE (ires) natom, nspin, nao, nset_max, nshell_max
         WRITE (ires) nset_info
         WRITE (ires) nshell_info
         WRITE (ires) nso_info

         DEALLOCATE (nset_info)

         DEALLOCATE (nshell_info)

         DEALLOCATE (nso_info)
      END IF

      ! use the scalapack block size as a default for buffering columns
      CALL cp_fm_get_info(mo_array(1)%mo_coeff, ncol_block=max_block)
      DO ispin = 1, nspin
         nmo = mo_array(ispin)%nmo
         IF ((ires > 0) .AND. (nmo > 0)) THEN
            WRITE (ires) nmo, &
               mo_array(ispin)%homo, &
               mo_array(ispin)%lfomo, &
               mo_array(ispin)%nelectron
            WRITE (ires) mo_array(ispin)%eigenvalues(1:nmo), &
               mo_array(ispin)%occupation_numbers(1:nmo)
         END IF
         IF (PRESENT(rt_mos)) THEN
            DO imat = 2*ispin - 1, 2*ispin
               CALL cp_fm_write_unformatted(rt_mos(imat), ires)
            END DO
         ELSE
            CALL cp_fm_write_unformatted(mo_array(ispin)%mo_coeff, ires)
         END IF
      END DO

      CALL timestop(handle)

   END SUBROUTINE write_mo_set_low

! **************************************************************************************************
!> \brief ...
!> \param filename ...
!> \param exist ...
!> \param section ...
!> \param logger ...
!> \param kp ...
!> \param xas ...
!> \param rtp ...
! **************************************************************************************************
   SUBROUTINE wfn_restart_file_name(filename, exist, section, logger, kp, xas, rtp)
      CHARACTER(LEN=default_path_length), INTENT(OUT)    :: filename
      LOGICAL, INTENT(OUT)                               :: exist
      TYPE(section_vals_type), POINTER                   :: section
      TYPE(cp_logger_type), POINTER                      :: logger
      LOGICAL, INTENT(IN), OPTIONAL                      :: kp, xas, rtp

      INTEGER                                            :: n_rep_val
      LOGICAL                                            :: my_kp, my_rtp, my_xas
      TYPE(section_vals_type), POINTER                   :: print_key

      my_kp = .FALSE.
      my_xas = .FALSE.
      my_rtp = .FALSE.
      IF (PRESENT(kp)) my_kp = kp
      IF (PRESENT(xas)) my_xas = xas
      IF (PRESENT(rtp)) my_rtp = rtp

      exist = .FALSE.
      CALL section_vals_val_get(section, "WFN_RESTART_FILE_NAME", n_rep_val=n_rep_val)
      IF (n_rep_val > 0) THEN
         CALL section_vals_val_get(section, "WFN_RESTART_FILE_NAME", c_val=filename)
      ELSE
         IF (my_xas) THEN
            ! try to read from the filename that is generated automatically from the printkey
            print_key => section_vals_get_subs_vals(section, "PRINT%RESTART")
            filename = cp_print_key_generate_filename(logger, print_key, &
                                                      extension="", my_local=.FALSE.)
         ELSE IF (my_rtp) THEN
            ! try to read from the filename that is generated automatically from the printkey
            print_key => section_vals_get_subs_vals(section, "REAL_TIME_PROPAGATION%PRINT%RESTART")
            filename = cp_print_key_generate_filename(logger, print_key, &
                                                      extension=".rtpwfn", my_local=.FALSE.)
         ELSE IF (my_kp) THEN
            ! try to read from the filename that is generated automatically from the printkey
            print_key => section_vals_get_subs_vals(section, "SCF%PRINT%RESTART")
            filename = cp_print_key_generate_filename(logger, print_key, &
                                                      extension=".kp", my_local=.FALSE.)
         ELSE
            ! try to read from the filename that is generated automatically from the printkey
            print_key => section_vals_get_subs_vals(section, "SCF%PRINT%RESTART")
            filename = cp_print_key_generate_filename(logger, print_key, &
                                                      extension=".wfn", my_local=.FALSE.)
         END IF
      END IF
      IF (.NOT. my_xas) THEN
         INQUIRE (FILE=filename, exist=exist)
      END IF

   END SUBROUTINE wfn_restart_file_name

! **************************************************************************************************
!> \brief ...
!> \param mo_array ...
!> \param atomic_kind_set ...
!> \param qs_kind_set ...
!> \param particle_set ...
!> \param para_env ...
!> \param id_nr ...
!> \param multiplicity ...
!> \param dft_section ...
!> \param natom_mismatch ...
!> \param cdft ...
!> \param out_unit ...
! **************************************************************************************************
   SUBROUTINE read_mo_set_from_restart(mo_array, atomic_kind_set, qs_kind_set, particle_set, &
                                       para_env, id_nr, multiplicity, dft_section, natom_mismatch, &
                                       cdft, out_unit)

      TYPE(mo_set_type), DIMENSION(:), INTENT(INOUT)     :: mo_array
      TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(mp_para_env_type), POINTER                    :: para_env
      INTEGER, INTENT(IN)                                :: id_nr, multiplicity
      TYPE(section_vals_type), POINTER                   :: dft_section
      LOGICAL, INTENT(OUT), OPTIONAL                     :: natom_mismatch
      LOGICAL, INTENT(IN), OPTIONAL                      :: cdft
      INTEGER, INTENT(IN), OPTIONAL                      :: out_unit

      CHARACTER(LEN=*), PARAMETER :: routineN = 'read_mo_set_from_restart'

      CHARACTER(LEN=default_path_length)                 :: file_name
      INTEGER                                            :: handle, ispin, my_out_unit, natom, &
                                                            nspin, restart_unit
      LOGICAL                                            :: exist, my_cdft
      TYPE(cp_logger_type), POINTER                      :: logger

      CALL timeset(routineN, handle)
      logger => cp_get_default_logger()
      my_cdft = .FALSE.
      IF (PRESENT(cdft)) my_cdft = cdft
      my_out_unit = -1
      IF (PRESENT(out_unit)) my_out_unit = out_unit

      nspin = SIZE(mo_array)
      restart_unit = -1

      IF (para_env%is_source()) THEN

         natom = SIZE(particle_set, 1)
         CALL wfn_restart_file_name(file_name, exist, dft_section, logger)
         IF (id_nr /= 0) THEN
            ! Is it one of the backup files?
            file_name = TRIM(file_name)//".bak-"//ADJUSTL(cp_to_string(id_nr))
         END IF

         CALL open_file(file_name=file_name, &
                        file_action="READ", &
                        file_form="UNFORMATTED", &
                        file_status="OLD", &
                        unit_number=restart_unit)

      END IF

      CALL read_mos_restart_low(mo_array, para_env=para_env, qs_kind_set=qs_kind_set, &
                                particle_set=particle_set, natom=natom, &
                                rst_unit=restart_unit, multiplicity=multiplicity, natom_mismatch=natom_mismatch)

      IF (PRESENT(natom_mismatch)) THEN
         ! read_mos_restart_low only the io_node returns natom_mismatch, must broadcast it
         CALL para_env%bcast(natom_mismatch)
         IF (natom_mismatch) THEN
            IF (para_env%is_source()) CALL close_file(unit_number=restart_unit)
            CALL timestop(handle)
            RETURN
         END IF
      END IF

      ! Close restart file
      IF (para_env%is_source()) THEN
         IF (my_out_unit > 0) THEN
            WRITE (UNIT=my_out_unit, FMT="(T2,A)") &
               "WFN_RESTART| Restart file "//TRIM(file_name)//" read"
         END IF
         CALL close_file(unit_number=restart_unit)
      END IF

      ! CDFT has no real dft_section and does not need to print
      IF (.NOT. my_cdft) THEN
         DO ispin = 1, nspin
            CALL write_mo_set_to_output_unit(mo_array(ispin), atomic_kind_set, qs_kind_set, &
                                             particle_set, dft_section, 4, 0, final_mos=.FALSE.)
         END DO
      END IF

      CALL timestop(handle)

   END SUBROUTINE read_mo_set_from_restart

! **************************************************************************************************
!> \brief ...
!> \param mo_array ...
!> \param rt_mos ...
!> \param atomic_kind_set ...
!> \param qs_kind_set ...
!> \param particle_set ...
!> \param para_env ...
!> \param id_nr ...
!> \param multiplicity ...
!> \param dft_section ...
! **************************************************************************************************
   SUBROUTINE read_rt_mos_from_restart(mo_array, rt_mos, atomic_kind_set, qs_kind_set, &
                                       particle_set, para_env, id_nr, multiplicity, dft_section)

      TYPE(mo_set_type), DIMENSION(:), INTENT(INOUT)     :: mo_array
      TYPE(cp_fm_type), DIMENSION(:), POINTER            :: rt_mos
      TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(mp_para_env_type), POINTER                    :: para_env
      INTEGER, INTENT(IN)                                :: id_nr, multiplicity
      TYPE(section_vals_type), POINTER                   :: dft_section

      CHARACTER(LEN=*), PARAMETER :: routineN = 'read_rt_mos_from_restart'

      CHARACTER(LEN=default_path_length)                 :: file_name
      INTEGER                                            :: handle, ispin, natom, nspin, &
                                                            restart_unit, unit_nr
      LOGICAL                                            :: exist
      TYPE(cp_logger_type), POINTER                      :: logger

      CALL timeset(routineN, handle)
      logger => cp_get_default_logger()

      nspin = SIZE(mo_array)
      restart_unit = -1

      IF (para_env%is_source()) THEN

         natom = SIZE(particle_set, 1)
         CALL wfn_restart_file_name(file_name, exist, dft_section, logger, rtp=.TRUE.)
         IF (id_nr /= 0) THEN
            ! Is it one of the backup files?
            file_name = TRIM(file_name)//".bak-"//ADJUSTL(cp_to_string(id_nr))
         END IF

         unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.)
         IF (unit_nr > 0) THEN
            WRITE (unit_nr, '(T2,A)') "Read RTP restart from the file: "//TRIM(file_name)
         END IF

         CALL open_file(file_name=file_name, &
                        file_action="READ", &
                        file_form="UNFORMATTED", &
                        file_status="OLD", &
                        unit_number=restart_unit)

      END IF

      CALL read_mos_restart_low(mo_array, rt_mos=rt_mos, para_env=para_env, &
                                particle_set=particle_set, qs_kind_set=qs_kind_set, natom=natom, &
                                rst_unit=restart_unit, multiplicity=multiplicity)

      ! Close restart file
      IF (para_env%is_source()) CALL close_file(unit_number=restart_unit)

      DO ispin = 1, nspin
         CALL write_mo_set_to_output_unit(mo_array(ispin), atomic_kind_set, qs_kind_set, &
                                          particle_set, dft_section, 4, 0, final_mos=.FALSE.)
      END DO

      CALL timestop(handle)

   END SUBROUTINE read_rt_mos_from_restart

! **************************************************************************************************
!> \brief Reading the mos from apreviously defined restart file
!> \param mos ...
!> \param para_env ...
!> \param qs_kind_set ...
!> \param particle_set ...
!> \param natom ...
!> \param rst_unit ...
!> \param multiplicity ...
!> \param rt_mos ...
!> \param natom_mismatch ...
!> \par History
!>      12.2007 created [MI]
!> \author MI
! **************************************************************************************************
   SUBROUTINE read_mos_restart_low(mos, para_env, qs_kind_set, particle_set, natom, rst_unit, &
                                   multiplicity, rt_mos, natom_mismatch)

      TYPE(mo_set_type), DIMENSION(:), INTENT(INOUT)     :: mos
      TYPE(mp_para_env_type), POINTER                    :: para_env
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      INTEGER, INTENT(IN)                                :: natom, rst_unit
      INTEGER, INTENT(in), OPTIONAL                      :: multiplicity
      TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER  :: rt_mos
      LOGICAL, INTENT(OUT), OPTIONAL                     :: natom_mismatch

      INTEGER :: homo, homo_read, i, iatom, ikind, imat, irow, iset, iset_read, ishell, &
         ishell_read, iso, ispin, lfomo_read, lmax, lshell, my_mult, nao, nao_read, natom_read, &
         nelectron, nelectron_read, nmo, nmo_read, nnshell, nset, nset_max, nshell_max, nspin, &
         nspin_read, offset_read
      INTEGER, DIMENSION(:), POINTER                     :: nset_info, nshell
      INTEGER, DIMENSION(:, :), POINTER                  :: l, nshell_info
      INTEGER, DIMENSION(:, :, :), POINTER               :: nso_info, offset_info
      LOGICAL                                            :: minbas, natom_match, use_this
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: eig_read, occ_read
      REAL(KIND=dp), DIMENSION(:, :), POINTER            :: vecbuffer, vecbuffer_read
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(gto_basis_set_type), POINTER                  :: orb_basis_set
      TYPE(qs_dftb_atom_type), POINTER                   :: dftb_parameter

      logger => cp_get_default_logger()

      nspin = SIZE(mos)
      nao = mos(1)%nao
      my_mult = 0
      IF (PRESENT(multiplicity)) my_mult = multiplicity

      IF (para_env%is_source()) THEN
         READ (rst_unit) natom_read, nspin_read, nao_read, nset_max, nshell_max
         IF (PRESENT(rt_mos)) THEN
            IF (nspin_read /= nspin) THEN
               CPABORT("To change nspin is not possible. ")
            END IF
         ELSE
            ! we should allow for restarting with different spin settings
            IF (nspin_read /= nspin) THEN
               WRITE (cp_logger_get_default_unit_nr(logger), *) &
                  "READ RESTART : WARNING : nspin is not equal "
            END IF
            ! this case needs fixing of homo/lfomo/nelec/occupations ...
            IF (nspin_read > nspin) THEN
               CPABORT("Reducing nspin is not possible. ")
            END IF
         END IF

         natom_match = (natom_read == natom)

         IF (natom_match) THEN ! actually do the read read

            ! Let's make it possible to change the basis set
            ALLOCATE (nso_info(nshell_max, nset_max, natom_read))
            ALLOCATE (nshell_info(nset_max, natom_read))
            ALLOCATE (nset_info(natom_read))
            ALLOCATE (offset_info(nshell_max, nset_max, natom_read))

            IF (nao_read /= nao) THEN
               WRITE (cp_logger_get_default_unit_nr(logger), *) &
                  " READ RESTART : WARNING : DIFFERENT # AOs ", nao, nao_read
               IF (PRESENT(rt_mos)) &
                  CPABORT("To change basis is not possible. ")
            END IF

            READ (rst_unit) nset_info
            READ (rst_unit) nshell_info
            READ (rst_unit) nso_info

            i = 1
            DO iatom = 1, natom
               DO iset = 1, nset_info(iatom)
                  DO ishell = 1, nshell_info(iset, iatom)
                     offset_info(ishell, iset, iatom) = i
                     i = i + nso_info(ishell, iset, iatom)
                  END DO
               END DO
            END DO

            ALLOCATE (vecbuffer_read(1, nao_read))

         END IF ! natom_match
      END IF ! ionode

      ! make natom_match and natom_mismatch uniform across all nodes
      CALL para_env%bcast(natom_match)
      IF (PRESENT(natom_mismatch)) natom_mismatch = .NOT. natom_match
      ! handle natom_match false
      IF (.NOT. natom_match) THEN
         IF (PRESENT(natom_mismatch)) THEN
            WRITE (cp_logger_get_default_unit_nr(logger), *) &
               " READ RESTART : WARNING : DIFFERENT natom, returning ", natom, natom_read
            RETURN
         ELSE
            CPABORT("Incorrect number of atoms in restart file. ")
         END IF
      END IF

      CALL para_env%bcast(nspin_read)

      ALLOCATE (vecbuffer(1, nao))

      DO ispin = 1, nspin

         nmo = mos(ispin)%nmo
         homo = mos(ispin)%homo
         mos(ispin)%eigenvalues(:) = 0.0_dp
         mos(ispin)%occupation_numbers(:) = 0.0_dp
         CALL cp_fm_set_all(mos(ispin)%mo_coeff, 0.0_dp)

         IF (para_env%is_source() .AND. (nmo > 0)) THEN
            READ (rst_unit) nmo_read, homo_read, lfomo_read, nelectron_read
            ALLOCATE (eig_read(nmo_read), occ_read(nmo_read))
            eig_read = 0.0_dp
            occ_read = 0.0_dp

            nmo = MIN(nmo, nmo_read)
            IF (nmo_read < nmo) &
               CALL cp_warn(__LOCATION__, &
                            "The number of MOs on the restart unit is smaller than the number of "// &
                            "the allocated MOs. The MO set will be padded with zeros!")
            IF (nmo_read > nmo) &
               CALL cp_warn(__LOCATION__, &
                            "The number of MOs on the restart unit is greater than the number of "// &
                            "the allocated MOs. The read MO set will be truncated!")

            READ (rst_unit) eig_read(1:nmo_read), occ_read(1:nmo_read)
            mos(ispin)%eigenvalues(1:nmo) = eig_read(1:nmo)
            mos(ispin)%occupation_numbers(1:nmo) = occ_read(1:nmo)
            DEALLOCATE (eig_read, occ_read)

            mos(ispin)%homo = homo_read
            mos(ispin)%lfomo = lfomo_read
            IF (homo_read > nmo) THEN
               IF (nelectron_read == mos(ispin)%nelectron) THEN
                  CALL cp_warn(__LOCATION__, &
                               "The number of occupied MOs on the restart unit is larger than "// &
                               "the allocated MOs. The read MO set will be truncated and the occupation numbers recalculated!")
                  CALL set_mo_occupation(mo_set=mos(ispin))
               ELSE
                  ! can not make this a warning i.e. homo must be smaller than nmo
                  ! otherwise e.g. set_mo_occupation will go out of bounds
                  CPABORT("Number of occupied MOs on restart unit larger than allocated MOs. ")
               END IF
            END IF
         END IF

         CALL para_env%bcast(nmo)
         CALL para_env%bcast(mos(ispin)%homo)
         CALL para_env%bcast(mos(ispin)%lfomo)
         CALL para_env%bcast(mos(ispin)%nelectron)
         CALL para_env%bcast(mos(ispin)%eigenvalues)
         CALL para_env%bcast(mos(ispin)%occupation_numbers)

         IF (PRESENT(rt_mos)) THEN
            DO imat = 2*ispin - 1, 2*ispin
               DO i = 1, nmo
                  IF (para_env%is_source()) THEN
                     READ (rst_unit) vecbuffer
                  ELSE
                     vecbuffer(1, :) = 0.0_dp
                  END IF
                  CALL para_env%bcast(vecbuffer)
                  CALL cp_fm_set_submatrix(rt_mos(imat), &
                                           vecbuffer, 1, i, nao, 1, transpose=.TRUE.)
               END DO
            END DO
         ELSE
            DO i = 1, nmo
               IF (para_env%is_source()) THEN
                  READ (rst_unit) vecbuffer_read
                  ! now, try to assign the read to the real vector
                  ! in case the basis set changed this involves some guessing
                  irow = 1
                  DO iatom = 1, natom
                     NULLIFY (orb_basis_set, dftb_parameter, l, nshell)
                     CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
                     CALL get_qs_kind(qs_kind_set(ikind), &
                                      basis_set=orb_basis_set, dftb_parameter=dftb_parameter)
                     IF (ASSOCIATED(orb_basis_set)) THEN
                        CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
                                               nset=nset, &
                                               nshell=nshell, &
                                               l=l)
                        minbas = .FALSE.
                     ELSEIF (ASSOCIATED(dftb_parameter)) THEN
                        CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
                        nset = 1
                        minbas = .TRUE.
                     ELSE
                        ! assume an atom without basis set
                        ! CPABORT("Unknown basis set type. ")
                        nset = 0
                     END IF

                     use_this = .TRUE.
                     iset_read = 1
                     DO iset = 1, nset
                        ishell_read = 1
                        IF (minbas) THEN
                           nnshell = lmax + 1
                        ELSE
                           nnshell = nshell(iset)
                        END IF
                        DO ishell = 1, nnshell
                           IF (minbas) THEN
                              lshell = ishell - 1
                           ELSE
                              lshell = l(ishell, iset)
                           END IF
                           IF (iset_read > nset_info(iatom)) use_this = .FALSE.
                           IF (use_this) THEN ! avoids out of bound access of the lower line if false
                              IF (nso(lshell) == nso_info(ishell_read, iset_read, iatom)) THEN
                                 offset_read = offset_info(ishell_read, iset_read, iatom)
                                 ishell_read = ishell_read + 1
                                 IF (ishell_read > nshell_info(iset, iatom)) THEN
                                    ishell_read = 1
                                    iset_read = iset_read + 1
                                 END IF
                              ELSE
                                 use_this = .FALSE.
                              END IF
                           END IF
                           DO iso = 1, nso(lshell)
                              IF (use_this) THEN
                                 IF (offset_read - 1 + iso .LT. 1 .OR. offset_read - 1 + iso .GT. nao_read) THEN
                                    vecbuffer(1, irow) = 0.0_dp
                                 ELSE
                                    vecbuffer(1, irow) = vecbuffer_read(1, offset_read - 1 + iso)
                                 END IF
                              ELSE
                                 vecbuffer(1, irow) = 0.0_dp
                              END IF
                              irow = irow + 1
                           END DO
                           use_this = .TRUE.
                        END DO
                     END DO
                  END DO

               ELSE

                  vecbuffer(1, :) = 0.0_dp

               END IF

               CALL para_env%bcast(vecbuffer)
               CALL cp_fm_set_submatrix(mos(ispin)%mo_coeff, &
                                        vecbuffer, 1, i, nao, 1, transpose=.TRUE.)
            END DO
         END IF
         ! Skip extra MOs if there any
         IF (para_env%is_source()) THEN
            !ignore nmo = 0
            IF (nmo > 0) THEN
               DO i = nmo + 1, nmo_read
                  READ (rst_unit) vecbuffer_read
               END DO
            END IF
         END IF

         IF (.NOT. PRESENT(rt_mos)) THEN
            IF (ispin == 1 .AND. nspin_read < nspin) THEN

               mos(ispin + 1)%homo = mos(ispin)%homo
               mos(ispin + 1)%lfomo = mos(ispin)%lfomo
               nelectron = mos(ispin)%nelectron
               IF (my_mult .NE. 1) THEN
                  CALL cp_abort(__LOCATION__, &
                                "Restarting an LSD calculation from an LDA wfn only works for multiplicity=1 (singlets).")
               END IF
               IF (mos(ispin + 1)%nelectron < 0) THEN
                  CPABORT("LSD: too few electrons for this multiplisity. ")
               END IF
               mos(ispin + 1)%eigenvalues = mos(ispin)%eigenvalues
               mos(ispin)%occupation_numbers = mos(ispin)%occupation_numbers/2.0_dp
               mos(ispin + 1)%occupation_numbers = mos(ispin)%occupation_numbers
               CALL cp_fm_to_fm(mos(ispin)%mo_coeff, mos(ispin + 1)%mo_coeff)
               EXIT
            END IF
         END IF
      END DO ! ispin

      DEALLOCATE (vecbuffer)

      IF (para_env%is_source()) THEN
         DEALLOCATE (vecbuffer_read)
         DEALLOCATE (offset_info)
         DEALLOCATE (nso_info)
         DEALLOCATE (nshell_info)
         DEALLOCATE (nset_info)
      END IF

   END SUBROUTINE read_mos_restart_low

! **************************************************************************************************
!> \brief Write MO information to output file (eigenvalues, occupation numbers, coefficients)
!> \param mo_set ...
!> \param atomic_kind_set ...
!> \param qs_kind_set ...
!> \param particle_set ...
!> \param dft_section ...
!> \param before Digits before the dot
!> \param kpoint An integer that labels the current k point, e.g. its index
!> \param final_mos ...
!> \param spin ...
!> \param solver_method ...
!> \param rtp ...
!> \param cpart ...
!> \param sim_step ...
!> \param umo_set ...
!> \date    15.05.2001
!> \par History:
!>       - Optionally print Cartesian MOs (20.04.2005, MK)
!>       - Revise printout of MO information (05.05.2021, MK)
!> \par Variables
!>       - after : Number of digits after point.
!>       - before: Number of digits before point.
!> \author  Matthias Krack (MK)
!> \version 1.1
! **************************************************************************************************
   SUBROUTINE write_mo_set_to_output_unit(mo_set, atomic_kind_set, qs_kind_set, particle_set, &
                                          dft_section, before, kpoint, final_mos, spin, &
                                          solver_method, rtp, cpart, sim_step, umo_set)

      TYPE(mo_set_type), INTENT(IN)                      :: mo_set
      TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
      TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
      TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      TYPE(section_vals_type), POINTER                   :: dft_section
      INTEGER, INTENT(IN)                                :: before, kpoint
      LOGICAL, INTENT(IN), OPTIONAL                      :: final_mos
      CHARACTER(LEN=*), INTENT(IN), OPTIONAL             :: spin
      CHARACTER(LEN=2), INTENT(IN), OPTIONAL             :: solver_method
      LOGICAL, INTENT(IN), OPTIONAL                      :: rtp
      INTEGER, INTENT(IN), OPTIONAL                      :: cpart, sim_step
      TYPE(mo_set_type), INTENT(IN), OPTIONAL            :: umo_set

      CHARACTER(LEN=12)                                  :: symbol
      CHARACTER(LEN=12), DIMENSION(:), POINTER           :: bcgf_symbol
      CHARACTER(LEN=14)                                  :: fmtstr5
      CHARACTER(LEN=15)                                  :: energy_str, orbital_str, step_string
      CHARACTER(LEN=2)                                   :: element_symbol, my_solver_method
      CHARACTER(LEN=2*default_string_length)             :: name
      CHARACTER(LEN=21)                                  :: vector_str
      CHARACTER(LEN=22)                                  :: fmtstr4
      CHARACTER(LEN=24)                                  :: fmtstr2
      CHARACTER(LEN=25)                                  :: fmtstr1
      CHARACTER(LEN=29)                                  :: fmtstr6
      CHARACTER(LEN=4)                                   :: reim
      CHARACTER(LEN=40)                                  :: fmtstr3
      CHARACTER(LEN=6), DIMENSION(:), POINTER            :: bsgf_symbol
      INTEGER :: after, first_mo, from, homo, iatom, icgf, ico, icol, ikind, imo, irow, iset, &
         isgf, ishell, iso, iw, jcol, last_mo, left, lmax, lshell, nao, natom, ncgf, ncol, nmo, &
         nset, nsgf, numo, right, scf_step, to, width
      INTEGER, DIMENSION(:), POINTER                     :: mo_index_range, nshell
      INTEGER, DIMENSION(:, :), POINTER                  :: l
      LOGICAL                                            :: ionode, my_final, my_rtp, &
                                                            print_cartesian, print_eigvals, &
                                                            print_eigvecs, print_occup, &
                                                            should_output
      REAL(KIND=dp)                                      :: gap, maxocc
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: mo_eigenvalues, mo_occupation_numbers
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: cmatrix, smatrix
      REAL(KIND=dp), DIMENSION(:), POINTER               :: eigenvalues, occupation_numbers
      TYPE(cp_fm_type), POINTER                          :: mo_coeff, umo_coeff
      TYPE(cp_logger_type), POINTER                      :: logger
      TYPE(gto_basis_set_type), POINTER                  :: orb_basis_set
      TYPE(qs_dftb_atom_type), POINTER                   :: dftb_parameter

      NULLIFY (bcgf_symbol)
      NULLIFY (bsgf_symbol)
      NULLIFY (logger)
      NULLIFY (mo_index_range)
      NULLIFY (nshell)
      NULLIFY (mo_coeff)

      logger => cp_get_default_logger()
      ionode = logger%para_env%is_source()
      CALL section_vals_val_get(dft_section, "PRINT%MO%EIGENVALUES", l_val=print_eigvals)
      CALL section_vals_val_get(dft_section, "PRINT%MO%EIGENVECTORS", l_val=print_eigvecs)
      CALL section_vals_val_get(dft_section, "PRINT%MO%OCCUPATION_NUMBERS", l_val=print_occup)
      CALL section_vals_val_get(dft_section, "PRINT%MO%CARTESIAN", l_val=print_cartesian)
      CALL section_vals_val_get(dft_section, "PRINT%MO%MO_INDEX_RANGE", i_vals=mo_index_range)
      CALL section_vals_val_get(dft_section, "PRINT%MO%NDIGITS", i_val=after)
      after = MIN(MAX(after, 1), 16)

      ! Do we print the final MO information after SCF convergence is reached (default: no)
      IF (PRESENT(final_mos)) THEN
         my_final = final_mos
      ELSE
         my_final = .FALSE.
      END IF

      ! complex MOS for RTP, no eigenvalues
      my_rtp = .FALSE.
      IF (PRESENT(rtp)) THEN
         my_rtp = rtp
         ! print the first time step if MO print required
         should_output = BTEST(cp_print_key_should_output(logger%iter_info, dft_section, &
                                                          "PRINT%MO"), cp_p_file) &
                         .OR. (sim_step == 1)
      ELSE
         should_output = BTEST(cp_print_key_should_output(logger%iter_info, dft_section, &
                                                          "PRINT%MO"), cp_p_file) .OR. my_final
      END IF

      IF ((.NOT. should_output) .OR. (.NOT. (print_eigvals .OR. print_eigvecs .OR. print_occup))) RETURN

      IF (my_rtp) THEN
         CPASSERT(PRESENT(sim_step))
         CPASSERT(PRESENT(cpart))
         scf_step = sim_step
         IF (cpart == 0) THEN
            reim = "IMAG"
         ELSE
            reim = "REAL"
         END IF
         print_eigvals = .FALSE.
      ELSE
         scf_step = MAX(0, logger%iter_info%iteration(logger%iter_info%n_rlevel) - 1)
      END IF

      IF (.NOT. my_final) THEN
         IF (.NOT. my_rtp) THEN
            step_string = " AFTER SCF STEP"
         ELSE
            step_string = " AFTER RTP STEP"
         END IF
      END IF

      IF (PRESENT(solver_method)) THEN
         my_solver_method = solver_method
      ELSE
         ! Traditional diagonalization is assumed as default solver method
         my_solver_method = "TD"
      END IF

      ! Retrieve MO information
      CALL get_mo_set(mo_set=mo_set, &
                      mo_coeff=mo_coeff, &
                      eigenvalues=eigenvalues, &
                      occupation_numbers=occupation_numbers, &
                      homo=homo, &
                      maxocc=maxocc, &
                      nao=nao, &
                      nmo=nmo)
      IF (PRESENT(umo_set)) THEN
         CALL get_mo_set(mo_set=umo_set, &
                         mo_coeff=umo_coeff, &
                         nmo=numo)
         nmo = nmo + numo
      ELSE
         numo = 0
      END IF
      ALLOCATE (mo_eigenvalues(nmo))
      mo_eigenvalues(:) = 0.0_dp
      mo_eigenvalues(1:nmo - numo) = eigenvalues(1:nmo - numo)
      ALLOCATE (mo_occupation_numbers(nmo))
      mo_occupation_numbers(:) = 0.0_dp
      mo_occupation_numbers(1:nmo - numo) = occupation_numbers(1:nmo - numo)
      IF (numo > 0) THEN
         CALL get_mo_set(mo_set=umo_set, &
                         eigenvalues=eigenvalues)
         mo_eigenvalues(nmo - numo + 1:nmo) = eigenvalues(1:numo)
      END IF

      IF (print_eigvecs) THEN
         ALLOCATE (smatrix(nao, nmo))
         CALL cp_fm_get_submatrix(mo_coeff, smatrix(1:nao, 1:nmo - numo))
         IF (numo > 0) THEN
            CALL cp_fm_get_submatrix(umo_coeff, smatrix(1:nao, nmo - numo + 1:nmo))
         END IF
         IF (.NOT. ionode) THEN
            DEALLOCATE (smatrix)
         END IF
      END IF

      iw = cp_print_key_unit_nr(logger, dft_section, "PRINT%MO", &
                                ignore_should_output=should_output, &
                                extension=".MOLog")

      IF (iw > 0) THEN

         CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
         CALL get_qs_kind_set(qs_kind_set, ncgf=ncgf, nsgf=nsgf)

         ! Definition of the variable formats

         fmtstr1 = "(T2,A,21X,  (  X,I5,  X))"
         fmtstr2 = "(T2,A,21X,  (1X,F  .  ))"
         fmtstr3 = "(T2,A,I5,1X,I5,1X,A,1X,A6,  (1X,F  .  ))"

         width = before + after + 3
         ncol = INT(56/width)

         right = MAX((after - 2), 1)
         left = width - right - 5

         WRITE (UNIT=fmtstr1(11:12), FMT="(I2)") ncol
         WRITE (UNIT=fmtstr1(14:15), FMT="(I2)") left
         WRITE (UNIT=fmtstr1(21:22), FMT="(I2)") right

         WRITE (UNIT=fmtstr2(11:12), FMT="(I2)") ncol
         WRITE (UNIT=fmtstr2(18:19), FMT="(I2)") width - 1
         WRITE (UNIT=fmtstr2(21:22), FMT="(I2)") after

         WRITE (UNIT=fmtstr3(27:28), FMT="(I2)") ncol
         WRITE (UNIT=fmtstr3(34:35), FMT="(I2)") width - 1
         WRITE (UNIT=fmtstr3(37:38), FMT="(I2)") after

         IF (my_final .OR. (my_solver_method == "TD")) THEN
            energy_str = "EIGENVALUES"
            vector_str = "EIGENVECTORS"
         ELSE
            energy_str = "ENERGIES"
            vector_str = "COEFFICIENTS"
         END IF

         IF (my_rtp) THEN
            energy_str = "ZEROS"
            vector_str = TRIM(reim)//" RTP COEFFICIENTS"
         END IF

         IF (print_eigvecs) THEN

            IF (print_cartesian) THEN

               orbital_str = "CARTESIAN"

               ALLOCATE (cmatrix(ncgf, ncgf))
               cmatrix = 0.0_dp

               ! Transform spherical MOs to Cartesian MOs
               icgf = 1
               isgf = 1
               DO iatom = 1, natom
                  NULLIFY (orb_basis_set, dftb_parameter)
                  CALL get_atomic_kind(particle_set(iatom)%atomic_kind, kind_number=ikind)
                  CALL get_qs_kind(qs_kind_set(ikind), &
                                   basis_set=orb_basis_set, &
                                   dftb_parameter=dftb_parameter)
                  IF (ASSOCIATED(orb_basis_set)) THEN
                     CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
                                            nset=nset, &
                                            nshell=nshell, &
                                            l=l)
                     DO iset = 1, nset
                        DO ishell = 1, nshell(iset)
                           lshell = l(ishell, iset)
                           CALL dgemm("T", "N", nco(lshell), nmo, nso(lshell), 1.0_dp, &
                                      orbtramat(lshell)%c2s, nso(lshell), &
                                      smatrix(isgf, 1), nsgf, 0.0_dp, &
                                      cmatrix(icgf, 1), ncgf)
                           icgf = icgf + nco(lshell)
                           isgf = isgf + nso(lshell)
                        END DO
                     END DO
                  ELSE IF (ASSOCIATED(dftb_parameter)) THEN
                     CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
                     DO ishell = 1, lmax + 1
                        lshell = ishell - 1
                        CALL dgemm("T", "N", nco(lshell), nsgf, nso(lshell), 1.0_dp, &
                                   orbtramat(lshell)%c2s, nso(lshell), &
                                   smatrix(isgf, 1), nsgf, 0.0_dp, &
                                   cmatrix(icgf, 1), ncgf)
                        icgf = icgf + nco(lshell)
                        isgf = isgf + nso(lshell)
                     END DO
                  ELSE
                     ! assume atom without basis set
                     ! CPABORT("Unknown basis set type")
                  END IF
               END DO ! iatom

            ELSE

               orbital_str = "SPHERICAL"

            END IF ! print_cartesian

            name = TRIM(energy_str)//", OCCUPATION NUMBERS, AND "// &
                   TRIM(orbital_str)//" "//TRIM(vector_str)

            IF (.NOT. my_final) &
               WRITE (UNIT=name, FMT="(A,1X,I0)") TRIM(name)//step_string, scf_step

         ELSE IF (print_occup .OR. print_eigvals) THEN
            name = TRIM(energy_str)//" AND OCCUPATION NUMBERS"

            IF (.NOT. my_final) &
               WRITE (UNIT=name, FMT="(A,1X,I0)") TRIM(name)//step_string, scf_step
         END IF ! print_eigvecs

         ! Print headline
         IF (PRESENT(spin) .AND. (kpoint > 0)) THEN
            WRITE (UNIT=iw, FMT="(/,T2,A,I0)") &
               "MO| "//TRIM(spin)//" "//TRIM(name)//" FOR K POINT ", kpoint
         ELSE IF (PRESENT(spin)) THEN
            WRITE (UNIT=iw, FMT="(/,T2,A)") &
               "MO| "//TRIM(spin)//" "//TRIM(name)
         ELSE IF (kpoint > 0) THEN
            WRITE (UNIT=iw, FMT="(/,T2,A,I0)") &
               "MO| "//TRIM(name)//" FOR K POINT ", kpoint
         ELSE
            WRITE (UNIT=iw, FMT="(/,T2,A)") &
               "MO| "//TRIM(name)
         END IF

         ! Check if only a subset of the MOs has to be printed
         IF ((mo_index_range(1) > 0) .AND. &
             (mo_index_range(2) > 0) .AND. &
             (mo_index_range(2) >= mo_index_range(1))) THEN
            first_mo = MAX(1, mo_index_range(1))
            last_mo = MIN(nmo, mo_index_range(2))
         ELSE
            first_mo = 1
            last_mo = nmo
         END IF

         IF (print_eigvecs) THEN

            ! Print full MO information

            DO icol = first_mo, last_mo, ncol

               from = icol
               to = MIN((from + ncol - 1), last_mo)

               WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
               WRITE (UNIT=iw, FMT=fmtstr1) &
                  "MO|", (jcol, jcol=from, to)
               WRITE (UNIT=iw, FMT=fmtstr2) &
                  "MO|", (mo_eigenvalues(jcol), jcol=from, to)
               WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
               WRITE (UNIT=iw, FMT=fmtstr2) &
                  "MO|", (mo_occupation_numbers(jcol), jcol=from, to)
               WRITE (UNIT=iw, FMT="(T2,A)") "MO|"

               irow = 1

               DO iatom = 1, natom

                  IF (iatom /= 1) WRITE (UNIT=iw, FMT="(T2,A)") "MO|"

                  NULLIFY (orb_basis_set, dftb_parameter)
                  CALL get_atomic_kind(particle_set(iatom)%atomic_kind, &
                                       element_symbol=element_symbol, kind_number=ikind)
                  CALL get_qs_kind(qs_kind_set(ikind), &
                                   basis_set=orb_basis_set, &
                                   dftb_parameter=dftb_parameter)

                  IF (print_cartesian) THEN

                     IF (ASSOCIATED(orb_basis_set)) THEN
                        CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
                                               nset=nset, &
                                               nshell=nshell, &
                                               l=l, &
                                               cgf_symbol=bcgf_symbol)

                        icgf = 1
                        DO iset = 1, nset
                           DO ishell = 1, nshell(iset)
                              lshell = l(ishell, iset)
                              DO ico = 1, nco(lshell)
                                 WRITE (UNIT=iw, FMT=fmtstr3) &
                                    "MO|", irow, iatom, ADJUSTR(element_symbol), bcgf_symbol(icgf), &
                                    (cmatrix(irow, jcol), jcol=from, to)
                                 icgf = icgf + 1
                                 irow = irow + 1
                              END DO
                           END DO
                        END DO
                     ELSE IF (ASSOCIATED(dftb_parameter)) THEN
                        CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
                        icgf = 1
                        DO ishell = 1, lmax + 1
                           lshell = ishell - 1
                           DO ico = 1, nco(lshell)
                              symbol = cgf_symbol(1, indco(1:3, icgf))
                              symbol(1:2) = "  "
                              WRITE (UNIT=iw, FMT=fmtstr3) &
                                 "MO|", irow, iatom, ADJUSTR(element_symbol), symbol, &
                                 (cmatrix(irow, jcol), jcol=from, to)
                              icgf = icgf + 1
                              irow = irow + 1
                           END DO
                        END DO
                     ELSE
                        ! assume atom without basis set
                        ! CPABORT("Unknown basis set type")
                     END IF

                  ELSE

                     IF (ASSOCIATED(orb_basis_set)) THEN
                        CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
                                               nset=nset, &
                                               nshell=nshell, &
                                               l=l, &
                                               sgf_symbol=bsgf_symbol)
                        isgf = 1
                        DO iset = 1, nset
                           DO ishell = 1, nshell(iset)
                              lshell = l(ishell, iset)
                              DO iso = 1, nso(lshell)
                                 WRITE (UNIT=iw, FMT=fmtstr3) &
                                    "MO|", irow, iatom, ADJUSTR(element_symbol), bsgf_symbol(isgf), &
                                    (smatrix(irow, jcol), jcol=from, to)
                                 isgf = isgf + 1
                                 irow = irow + 1
                              END DO
                           END DO
                        END DO
                     ELSE IF (ASSOCIATED(dftb_parameter)) THEN
                        CALL get_dftb_atom_param(dftb_parameter, lmax=lmax)
                        isgf = 1
                        DO ishell = 1, lmax + 1
                           lshell = ishell - 1
                           DO iso = 1, nso(lshell)
                              symbol = sgf_symbol(1, lshell, -lshell + iso - 1)
                              symbol(1:2) = "  "
                              WRITE (UNIT=iw, FMT=fmtstr3) &
                                 "MO|", irow, iatom, ADJUSTR(element_symbol), symbol, &
                                 (smatrix(irow, jcol), jcol=from, to)
                              isgf = isgf + 1
                              irow = irow + 1
                           END DO
                        END DO
                     ELSE
                        ! assume atom without basis set
                        ! CPABORT("Unknown basis set type")
                     END IF

                  END IF ! print_cartesian

               END DO ! iatom

            END DO ! icol

            WRITE (UNIT=iw, FMT="(T2,A)") "MO|"

            ! Release work storage

            DEALLOCATE (smatrix)
            IF (print_cartesian) THEN
               DEALLOCATE (cmatrix)
            END IF

         ELSE IF (print_occup .OR. print_eigvals) THEN

            WRITE (UNIT=iw, FMT="(T2,A)") "MO|"
            fmtstr4 = "(T2,A,I7,3(1X,F22.  ))"
            WRITE (UNIT=fmtstr4(19:20), FMT="(I2)") after
            IF (my_final .OR. (my_solver_method == "TD")) THEN
               WRITE (UNIT=iw, FMT="(A)") &
                  " MO|  Index      Eigenvalue [a.u.]        Eigenvalue [eV]             Occupation"
            ELSE
               WRITE (UNIT=iw, FMT="(A)") &
                  " MO|  Index          Energy [a.u.]            Energy [eV]             Occupation"
            END IF
            DO imo = first_mo, last_mo
               WRITE (UNIT=iw, FMT=fmtstr4) &
                  "MO|", imo, mo_eigenvalues(imo), &
                  mo_eigenvalues(imo)*evolt, &
                  mo_occupation_numbers(imo)
            END DO
            fmtstr5 = "(A,T59,F22.  )"
            WRITE (UNIT=fmtstr5(12:13), FMT="(I2)") after
            WRITE (UNIT=iw, FMT=fmtstr5) &
               " MO| Sum:", accurate_sum(mo_occupation_numbers(:))

         END IF ! print_eigvecs

         IF (.NOT. my_rtp) THEN
            fmtstr6 = "(A,T18,F17.  ,A,T41,F17.  ,A)"
            WRITE (UNIT=fmtstr6(12:13), FMT="(I2)") after
            WRITE (UNIT=fmtstr6(25:26), FMT="(I2)") after
            WRITE (UNIT=iw, FMT=fmtstr6) &
               " MO| E(Fermi):", mo_set%mu, " a.u.", mo_set%mu*evolt, " eV"
         END IF
         IF ((homo > 0) .AND. .NOT. my_rtp) THEN
            IF ((mo_occupation_numbers(homo) == maxocc) .AND. (last_mo > homo)) THEN
               gap = mo_eigenvalues(homo + 1) - &
                     mo_eigenvalues(homo)
               WRITE (UNIT=iw, FMT=fmtstr6) &
                  " MO| Band gap:", gap, " a.u.", gap*evolt, " eV"
            END IF
         END IF
         WRITE (UNIT=iw, FMT="(A)") ""

      END IF ! iw

      IF (ALLOCATED(mo_eigenvalues)) DEALLOCATE (mo_eigenvalues)
      IF (ALLOCATED(mo_occupation_numbers)) DEALLOCATE (mo_occupation_numbers)

      CALL cp_print_key_finished_output(iw, logger, dft_section, "PRINT%MO", &
                                        ignore_should_output=should_output)

   END SUBROUTINE write_mo_set_to_output_unit

END MODULE qs_mo_io
