37                                              dbcsr_type_antisymmetric
 
  128#include "./base/base_uses.f90" 
  133   CHARACTER(len=*), 
PARAMETER, 
PRIVATE :: moduleN = 
'xas_methods' 
  161   SUBROUTINE xas(qs_env, dft_control)
 
  166      CHARACTER(LEN=*), 
PARAMETER                        :: routinen = 
'xas' 
  168      INTEGER :: handle, homo, i, iat, iatom, ispin, istate, my_homo(2), my_nelectron(2), my_spin, &
 
  169         nao, nexc_atoms, nexc_search, nmo, nspins, output_unit, state_to_be_excited
 
  170      INTEGER, 
DIMENSION(2)                              :: added_mos
 
  171      INTEGER, 
DIMENSION(:), 
POINTER                     :: nexc_states
 
  172      INTEGER, 
DIMENSION(:, :), 
POINTER                  :: state_of_atom
 
  173      LOGICAL                                            :: ch_method_flags, converged, my_uocc(2), &
 
  174                                                            should_stop, skip_scf, &
 
  176      REAL(
dp)                                           :: maxocc, occ_estate, tmp, xas_nelectron
 
  177      REAL(
dp), 
DIMENSION(:), 
POINTER                    :: eigenvalues
 
  178      REAL(
dp), 
DIMENSION(:, :), 
POINTER                 :: vecbuffer
 
  181      TYPE(
cp_fm_type), 
DIMENSION(:), 
POINTER            :: groundstate_coeff
 
  182      TYPE(
cp_fm_type), 
POINTER                          :: all_vectors, excvec_coeff, mo_coeff
 
  184      TYPE(
dbcsr_p_type), 
DIMENSION(:), 
POINTER          :: matrix_ks, op_sm, ostrength_sm
 
  189      TYPE(
qs_kind_type), 
DIMENSION(:), 
POINTER          :: qs_kind_set
 
  194                                                            print_loc_section, scf_section, &
 
  199      CALL timeset(routinen, handle)
 
  201      transition_potential = .false.
 
  204      should_stop = .false.
 
  205      ch_method_flags = .false.
 
  211      NULLIFY (xas_env, groundstate_coeff, ostrength_sm, op_sm)
 
  212      NULLIFY (excvec_coeff, qs_loc_env, cell, scf_env)
 
  214      NULLIFY (all_vectors, state_of_atom, nexc_states, 
xas_control)
 
  215      NULLIFY (vecbuffer, op_sm, mo_coeff_b)
 
  216      NULLIFY (dft_section, xas_section, scf_section, loc_section, print_loc_section)
 
  225      IF (output_unit > 0) 
THEN 
  226         WRITE (unit=output_unit, fmt=
"(/,T3,A,/,T25,A,/,T3,A,/)") &
 
  228            "START CORE LEVEL SPECTROSCOPY CALCULATION", &
 
  234      IF (.NOT. 
ASSOCIATED(xas_env)) 
THEN 
  235         IF (output_unit > 0) 
THEN 
  236            WRITE (unit=output_unit, fmt=
"(/,T5,A)") &
 
  237               "Create and initialize the xas environment" 
  241         CALL xas_env_init(xas_env, qs_env, dft_section, logger)
 
  247      NULLIFY (atomic_kind_set, qs_kind_set, scf_control, mos, para_env, particle_set)
 
  248      CALL get_qs_env(qs_env=qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, &
 
  249                      cell=cell, scf_control=scf_control, &
 
  250                      matrix_ks=matrix_ks, mos=mos, para_env=para_env, &
 
  251                      particle_set=particle_set)
 
  254      NULLIFY (mo_coeff, eigenvalues)
 
  255      IF (scf_control%use_ot) 
THEN 
  256         IF (output_unit > 0) 
THEN 
  257            WRITE (unit=output_unit, fmt=
"(/,T10,A,/)") &
 
  258               "Get eigenstates and eigenvalues from ground state MOs" 
  260         DO ispin = 1, dft_control%nspins
 
  261            CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, nao=nao, nmo=nmo, &
 
  262                            eigenvalues=eigenvalues, homo=homo)
 
  264                                                matrix_ks(ispin)%matrix, eigenvalues, &
 
  269      added_mos = scf_control%added_mos
 
  270      NULLIFY (scf_control)
 
  273      scf_control%added_mos = added_mos
 
  278      DO ispin = 1, dft_control%nspins
 
  279         CALL get_mo_set(mos(ispin), nelectron=my_nelectron(ispin), maxocc=maxocc, &
 
  280                         homo=my_homo(ispin), uniform_occupation=my_uocc(ispin))
 
  283      nspins = dft_control%nspins
 
  285      transition_potential = .true. 
 
  290      IF (nspins == 1 .AND. transition_potential) 
THEN 
  291         cpabort(
"XAS with TP method requires LSD calculations")
 
  295                       all_vectors=all_vectors, &
 
  296                       groundstate_coeff=groundstate_coeff, excvec_coeff=excvec_coeff, &
 
  297                       nexc_atoms=nexc_atoms, &
 
  298                       spin_channel=my_spin)
 
  301      CALL get_mo_set(mos(my_spin), nao=nao, homo=homo)
 
  305      CALL set_xas_env(xas_env=xas_env, nexc_search=nexc_search)
 
  308      CALL get_xas_env(xas_env=xas_env, qs_loc_env=qs_loc_env)
 
  309      IF (qs_loc_env%do_localize) 
THEN 
  310         IF (output_unit > 0) 
THEN 
  311            WRITE (unit=output_unit, fmt=
"(/,T2,A34,I3,A36/)") &
 
  312               "Localize a sub-set of MOs of spin ", my_spin, 
","// &
 
  313               " to better identify the core states" 
  315               qs_loc_env%localized_wfn_control%set_of_states == 
state_loc_range) 
THEN 
  316               WRITE (unit=output_unit, fmt=
"( A , I7, A, I7)") 
" The sub-set contains states from ", &
 
  317                  qs_loc_env%localized_wfn_control%lu_bound_states(1, my_spin), 
" to ", &
 
  318                  qs_loc_env%localized_wfn_control%lu_bound_states(2, my_spin)
 
  319            ELSEIF (qs_loc_env%localized_wfn_control%set_of_states == 
state_loc_list) 
THEN 
  320               WRITE (unit=output_unit, fmt=
"( A )") 
" The sub-set contains states given in the input list" 
  324         CALL qs_loc_driver(qs_env, qs_loc_env, print_loc_section, myspin=my_spin)
 
  327      cpassert(
ASSOCIATED(groundstate_coeff))
 
  329         CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, mo_coeff_b=mo_coeff_b, nmo=nmo)
 
  330         CALL cp_fm_to_fm(mo_coeff, groundstate_coeff(ispin), nmo, 1, 1)
 
  331         IF (
ASSOCIATED(mo_coeff_b)) 
THEN 
  341         IF (output_unit > 0) 
WRITE (unit=output_unit, fmt=
'(/,/,T10,A)') &
 
  342            "START Core Level Spectroscopy Calculation for the Emission Spectrum" 
  344            IF (output_unit > 0) 
WRITE (unit=output_unit, fmt=
'(T10,A,/,A)') &
 
  345               "The core state is fully occupied and XES from ground state calculation.", &
 
  346               " No SCF is needed, MOS already available" 
  347         ELSE IF (
xas_control%xes_homo_occupation == 0) 
THEN 
  348            IF (output_unit > 0) 
WRITE (unit=output_unit, fmt=
'(T10,A,/,A)') &
 
  349               "The core state is fully occupied and the homo is empty", &
 
  350               " (final state of the core hole decay). Only one SCF is needed (not one per atom)" 
  355         CALL xes_scf_once(qs_env, xas_env, converged, should_stop)
 
  357         IF (converged .AND. .NOT. should_stop .AND. 
xas_control%xes_homo_occupation == 0) 
THEN 
  358            IF (output_unit > 0) 
WRITE (unit=output_unit, fmt=
'(/,T10,A,I6)') &
 
  359               "SCF with empty homo converged " 
  360         ELSE IF (.NOT. converged .OR. should_stop) 
THEN 
  361            IF (output_unit > 0) 
WRITE (unit=output_unit, fmt=
'(/,T10,A,I6)') &
 
  362               "SCF with empty homo NOT converged" 
  364            IF (
ASSOCIATED(vecbuffer)) 
THEN 
  365               DEALLOCATE (vecbuffer)
 
  369            DO ispin = 1, dft_control%nspins
 
  370               CALL set_mo_set(mos(ispin), homo=my_homo(ispin), &
 
  371                               uniform_occupation=my_uocc(ispin), nelectron=my_nelectron(ispin))
 
  372               CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, nmo=nmo)
 
  373               CALL cp_fm_to_fm(groundstate_coeff(ispin), mos(ispin)%mo_coeff, nmo, 1, 1)
 
  376            IF (output_unit > 0) 
THEN 
  377               WRITE (unit=output_unit, fmt=
"(/,T3,A,/,T25,A,/,T3,A,/)") &
 
  379                  "END CORE LEVEL SPECTROSCOPY CALCULATION", &
 
  384            DEALLOCATE (qs_env%xas_env)
 
  385            NULLIFY (qs_env%xas_env)
 
  388                                              "PRINT%PROGRAM_RUN_INFO")
 
  389            CALL timestop(handle)
 
  396      CALL cls_assign_core_states(
xas_control, xas_env, qs_loc_env%localized_wfn_control, &
 
  399                       state_of_atom=state_of_atom, nexc_states=nexc_states)
 
  402         CALL get_mo_set(mos(my_spin), mo_coeff=mo_coeff)
 
  403         CALL cp_fm_to_fm(mo_coeff, all_vectors, ncol=nexc_search, &
 
  404                          source_start=1, target_start=1)
 
  407      ALLOCATE (vecbuffer(1, nao))
 
  411      IF (transition_potential) 
THEN 
  413         CALL get_xas_env(xas_env=xas_env, ostrength_sm=ostrength_sm)
 
  415            NULLIFY (op_sm(i)%matrix)
 
  416            op_sm(i)%matrix => ostrength_sm(i)%matrix
 
  424      DO iat = 1, nexc_atoms
 
  425         iatom = xas_env%exc_atoms(iat)
 
  426         DO istate = 1, nexc_states(iat)
 
  428            state_to_be_excited = state_of_atom(iat, istate)
 
  432            CALL get_xas_env(xas_env, occ_estate=occ_estate, xas_nelectron=xas_nelectron)
 
  433            tmp = xas_nelectron + 1.0_dp - occ_estate
 
  435               cpabort(
"CLS: the required method needs added_mos to the ground state")
 
  443                                     state_to_be_excited, istate)
 
  445            CALL set_xas_env(xas_env=xas_env, xas_estate=state_to_be_excited)
 
  446            CALL get_mo_set(mos(my_spin), mo_coeff=mo_coeff)
 
  447            cpassert(
ASSOCIATED(excvec_coeff))
 
  449                                     nao, 1, transpose=.true.)
 
  451                                     nao, 1, transpose=.true.)
 
  453            IF (transition_potential) 
THEN 
  455               IF (.NOT. skip_scf) 
THEN 
  456                  IF (output_unit > 0) 
THEN 
  457                     WRITE (unit=output_unit, fmt=
'(/,T5,A)') repeat(
"-", 75)
 
  459                        WRITE (unit=output_unit, fmt=
'(/,/,T10,A,I6)') &
 
  460                           "START DeltaSCF for the first excited state from the core state of ATOM ", iatom
 
  462                        WRITE (unit=output_unit, fmt=
'(/,T10,A,I6)') &
 
  463                           "Start Core Level Spectroscopy Calculation with TP approach for ATOM ", iatom
 
  464                        WRITE (unit=output_unit, fmt=
'(/,T10,A,I6,T34,A,T54,I6)') &
 
  465                           "Excited state", istate, 
"out of", nexc_states(iat)
 
  466                        WRITE (unit=output_unit, fmt=
'(T10,A,T50,f10.4)') 
"Occupation of the core orbital", &
 
  468                        WRITE (unit=output_unit, fmt=
'(T10,A28,I3, T50,F10.4)') 
"Number of electrons in Spin ", &
 
  469                           my_spin, xas_nelectron
 
  474                  IF (.NOT. 
ASSOCIATED(scf_env)) 
THEN 
  482                  DO ispin = 1, 
SIZE(mos)
 
  483                     IF (
ASSOCIATED(mos(ispin)%mo_coeff_b)) 
THEN  
  485                                              mos(ispin)%mo_coeff_b) 
 
  489                  IF (.NOT. scf_env%skip_diis) 
THEN 
  490                     IF (.NOT. 
ASSOCIATED(scf_env%scf_diis_buffer)) 
THEN 
  491                        ALLOCATE (scf_env%scf_diis_buffer)
 
  492                        CALL qs_diis_b_create(scf_env%scf_diis_buffer, nbuffer=scf_control%max_diis)
 
  497                  CALL xas_do_tp_scf(dft_control, xas_env, iatom, istate, scf_env, qs_env, &
 
  498                                     xas_section, scf_section, converged, should_stop)
 
  501                                        start_time=qs_env%start_time)
 
  502                  IF (should_stop) 
THEN 
  511               IF (
SIZE(mos) > 1) 
THEN 
  513                                                   4, 0, final_mos=.false., spin=
"XAS ALPHA")
 
  515                                                   4, 0, final_mos=.false., spin=
"XAS BETA")
 
  518                                                   4, 0, final_mos=.false., spin=
"XAS")
 
  529               CALL cls_calculate_spectrum(
xas_control, xas_env, qs_env, xas_section, &
 
  532               IF (output_unit > 0) 
WRITE (unit=output_unit, fmt=
'(/,/,T10,A,I6)') &
 
  533                  "SCF with core hole NOT converged for ATOM ", iatom
 
  536            IF (.NOT. skip_scf) 
THEN 
  542                  CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, nmo=nmo)
 
  543                  CALL cp_fm_to_fm(groundstate_coeff(ispin), mos(ispin)%mo_coeff, nmo, 1, 1)
 
  545               IF (iat == nexc_atoms) 
THEN 
  548                  DEALLOCATE (xas_env%scf_env)
 
  558      IF (
ASSOCIATED(vecbuffer)) 
THEN 
  559         DEALLOCATE (vecbuffer)
 
  563      DO ispin = 1, dft_control%nspins
 
  564         CALL set_mo_set(mos(ispin), homo=my_homo(ispin), &
 
  565                         uniform_occupation=my_uocc(ispin), nelectron=my_nelectron(ispin))
 
  566         CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, nmo=nmo)
 
  567         CALL cp_fm_to_fm(groundstate_coeff(ispin), mos(ispin)%mo_coeff, nmo, 1, 1)
 
  570      IF (output_unit > 0) 
THEN 
  571         WRITE (unit=output_unit, fmt=
"(/,T3,A,/,T25,A,/,T3,A,/)") &
 
  573            "END CORE LEVEL SPECTROSCOPY CALCULATION", &
 
  578      DEALLOCATE (qs_env%xas_env)
 
  579      NULLIFY (qs_env%xas_env)
 
  582                                        "PRINT%PROGRAM_RUN_INFO")
 
  583      CALL timestop(handle)
 
 
  597   SUBROUTINE xas_env_init(xas_env, qs_env, dft_section, logger)
 
  604      CHARACTER(LEN=default_string_length)               :: name_sto
 
  605      INTEGER :: homo, i, iat, iatom, ik, ikind, ispin, j, l, lfomo, my_spin, n_mo(2), n_rep, nao, &
 
  606         natom, ncubes, nelectron, nexc_atoms, nexc_search, nj, nk, nkind, nmo, nmoloc(2), &
 
  607         nsgf_gto, nsgf_sto, nspins, nvirtual, nvirtual2
 
  608      INTEGER, 
ALLOCATABLE, 
DIMENSION(:)                 :: first_sgf, kind_type_tmp, kind_z_tmp, &
 
  610      INTEGER, 
DIMENSION(4, 7)                           :: ne
 
  611      INTEGER, 
DIMENSION(:), 
POINTER                     :: bounds, 
list, lq, nq, row_blk_sizes
 
  613      REAL(
dp)                                           :: nele, occ_estate, occ_homo, &
 
  615      REAL(
dp), 
DIMENSION(:), 
POINTER                    :: sto_zet
 
  629      TYPE(
qs_kind_type), 
DIMENSION(:), 
POINTER          :: qs_kind_set
 
  638      cpassert(
ASSOCIATED(xas_env))
 
  640      NULLIFY (atomic_kind_set, qs_kind_set, dft_control, scf_control, matrix_s, mos, mpools)
 
  645                      atomic_kind_set=atomic_kind_set, &
 
  646                      qs_kind_set=qs_kind_set, &
 
  647                      dft_control=dft_control, &
 
  649                      matrix_s=matrix_s, mos=mos, &
 
  650                      para_env=para_env, particle_set=particle_set, &
 
  652                      dbcsr_dist=dbcsr_dist)
 
  655      ALLOCATE (dft_control%xas_control)
 
  660      ALLOCATE (scf_control)
 
  667      IF (nexc_search < 0) 
THEN 
  669         CALL get_mo_set(mos(my_spin), nmo=nmo, lfomo=lfomo)
 
  670         nexc_search = lfomo - 1
 
  673      ALLOCATE (xas_env%exc_atoms(nexc_atoms))
 
  675      CALL set_xas_env(xas_env=xas_env, nexc_search=nexc_search, &
 
  676                       nexc_atoms=nexc_atoms, spin_channel=my_spin)
 
  678      CALL mpools_get(mpools, ao_mo_fm_pools=xas_env%ao_mo_fm_pools)
 
  681      CALL get_mo_set(mos(my_spin), nao=nao, homo=homo, nmo=nmo, mo_coeff=mo_coeff, nelectron=nelectron)
 
  687         xas_env%unoccupied_max_iter = 
xas_control%max_iter_added
 
  689      nvirtual = nmo + nvirtual2
 
  693      ALLOCATE (xas_env%centers_wfn(3, nexc_search))
 
  694      ALLOCATE (xas_env%atom_of_state(nexc_search))
 
  695      ALLOCATE (xas_env%type_of_state(nexc_search))
 
  696      ALLOCATE (xas_env%state_of_atom(nexc_atoms, nexc_search))
 
  697      ALLOCATE (xas_env%nexc_states(nexc_atoms))
 
  698      ALLOCATE (xas_env%mykind_of_atom(nexc_atoms))
 
  699      nkind = 
SIZE(atomic_kind_set, 1)
 
  700      ALLOCATE (xas_env%mykind_of_kind(nkind))
 
  701      xas_env%mykind_of_kind = 0
 
  704      NULLIFY (tmp_fm_struct)
 
  706                               ncol_global=1, para_env=para_env, context=mo_coeff%matrix_struct%context)
 
  707      ALLOCATE (xas_env%excvec_coeff)
 
  711      NULLIFY (tmp_fm_struct)
 
  713                               ncol_global=nexc_search, para_env=para_env, &
 
  714                               context=mo_coeff%matrix_struct%context)
 
  715      ALLOCATE (xas_env%excvec_overlap)
 
  716      CALL cp_fm_create(xas_env%excvec_overlap, tmp_fm_struct)
 
  719      nspins = 
SIZE(mos, 1)
 
  724         nele = real(nelectron, 
dp) - 0.5_dp
 
  726         occ_homo_plus = 0._dp
 
  729         nele = real(nelectron, 
dp)
 
  731         occ_homo_plus = 0.5_dp
 
  734         nele = real(nelectron, 
dp) - 1.0_dp
 
  736         occ_homo_plus = 0._dp
 
  739         nele = real(nelectron, 
dp)
 
  741         occ_homo_plus = 1._dp
 
  748         nele = real(nelectron, 
dp)
 
  750         occ_homo_plus = 1._dp
 
  754         IF (nele < 0.0_dp) nele = real(nelectron, 
dp) - (1.0_dp - occ_estate)
 
  757      CALL set_xas_env(xas_env=xas_env, occ_estate=occ_estate, xas_nelectron=nele, &
 
  758                       nvirtual2=nvirtual2, nvirtual=nvirtual, homo_occ=occ_homo)
 
  762                                           "PRINT%CLS_FUNCTION_CUBES"), 
cp_p_file)) 
THEN 
  763         NULLIFY (bounds, 
list)
 
  765                                   "PRINT%CLS_FUNCTION_CUBES%CUBES_LU_BOUNDS", &
 
  767         ncubes = bounds(2) - bounds(1) + 1
 
  778                                      "PRINT%CLS_FUNCTION_CUBES%CUBES_LIST", &
 
  784                                         "PRINT%CLS_FUNCTION_CUBES%CUBES_LIST", &
 
  785                                         i_rep_val=ik, i_vals=
list)
 
  786               IF (
ASSOCIATED(
list)) 
THEN 
  791                  ncubes = ncubes + 
SIZE(
list)
 
  808      NULLIFY (tmp_fm_struct)
 
  809      ALLOCATE (xas_env%groundstate_coeff(nspins))
 
  813                                xas_env%groundstate_coeff(ispin), &
 
  817      NULLIFY (tmp_fm_struct)
 
  819                               ncol_global=nvirtual, para_env=para_env, &
 
  820                               context=mo_coeff%matrix_struct%context)
 
  821      ALLOCATE (xas_env%dip_fm_set(2, 3))
 
  824            CALL cp_fm_create(xas_env%dip_fm_set(j, i), tmp_fm_struct)
 
  830      IF (nvirtual2 .GT. 0) 
THEN 
  831         ALLOCATE (xas_env%unoccupied_evals(nvirtual2))
 
  832         NULLIFY (tmp_fm_struct)
 
  834                                  ncol_global=nvirtual2, &
 
  835                                  para_env=para_env, context=mo_coeff%matrix_struct%context)
 
  836         ALLOCATE (xas_env%unoccupied_orbs)
 
  837         CALL cp_fm_create(xas_env%unoccupied_orbs, tmp_fm_struct)
 
  841      NULLIFY (tmp_fm_struct)
 
  843                               ncol_global=nvirtual, &
 
  844                               para_env=para_env, context=mo_coeff%matrix_struct%context)
 
  845      ALLOCATE (xas_env%all_vectors)
 
  850      ALLOCATE (xas_env%all_evals(nvirtual))
 
  855            ALLOCATE (xas_env%ostrength_sm(i)%matrix)
 
  856            CALL dbcsr_copy(xas_env%ostrength_sm(i)%matrix, matrix_s(1)%matrix, &
 
  857                            "xas_env%ostrength_sm-"//trim(adjustl(
cp_to_string(i))))
 
  858            CALL dbcsr_set(xas_env%ostrength_sm(i)%matrix, 0.0_dp)
 
  863         natom = 
SIZE(particle_set, 1)
 
  864         ALLOCATE (first_sgf(natom))
 
  865         ALLOCATE (last_sgf(natom))
 
  867                               first_sgf=first_sgf, &
 
  869         ALLOCATE (row_blk_sizes(natom))
 
  870         CALL dbcsr_convert_offsets_to_sizes(first_sgf, row_blk_sizes, last_sgf)
 
  871         DEALLOCATE (first_sgf)
 
  872         DEALLOCATE (last_sgf)
 
  876         ALLOCATE (xas_env%ostrength_sm(1)%matrix)
 
  877         CALL dbcsr_create(matrix=xas_env%ostrength_sm(1)%matrix, &
 
  878                           name=
"xas_env%ostrength_sm", &
 
  879                           dist=dbcsr_dist, matrix_type=dbcsr_type_antisymmetric, &
 
  880                           row_blk_size=row_blk_sizes, col_blk_size=row_blk_sizes, &
 
  883         CALL dbcsr_set(xas_env%ostrength_sm(1)%matrix, 0.0_dp)
 
  885            ALLOCATE (xas_env%ostrength_sm(i)%matrix)
 
  886            CALL dbcsr_copy(xas_env%ostrength_sm(i)%matrix, xas_env%ostrength_sm(1)%matrix, &
 
  887                            "xas_env%ostrength_sm-"//trim(adjustl(
cp_to_string(i))))
 
  888            CALL dbcsr_set(xas_env%ostrength_sm(i)%matrix, 0.0_dp)
 
  891         DEALLOCATE (row_blk_sizes)
 
  895      IF (.NOT. (
ASSOCIATED(xas_env%qs_loc_env))) 
THEN 
  896         ALLOCATE (qs_loc_env)
 
  898         CALL set_xas_env(xas_env=xas_env, qs_loc_env=qs_loc_env)
 
  902                                  do_xas=.true., nloc_xas=nexc_search, spin_xas=my_spin)
 
  904         IF (.NOT. qs_loc_env%do_localize) 
THEN 
  905            qs_loc_env%localized_wfn_control%localization_method = 
do_loc_none 
  908            nmoloc = qs_loc_env%localized_wfn_control%nloc_states
 
  909            CALL set_loc_wfn_lists(qs_loc_env%localized_wfn_control, nmoloc, n_mo, nspins, my_spin)
 
  912                                 qs_env, myspin=my_spin, do_localize=qs_loc_env%do_localize)
 
  917      ALLOCATE (nq(1), lq(1), sto_zet(1))
 
  949         cpabort(
"XAS type of state not implemented")
 
  953      ALLOCATE (kind_type_tmp(nkind))
 
  954      ALLOCATE (kind_z_tmp(nkind))
 
  958      DO iat = 1, nexc_atoms
 
  959         iatom = xas_env%exc_atoms(iat)
 
  960         NULLIFY (atomic_kind)
 
  961         atomic_kind => particle_set(iatom)%atomic_kind
 
  966            IF (ikind == kind_type_tmp(ik)) 
THEN 
  968               xas_env%mykind_of_atom(iat) = ik
 
  972         IF (.NOT. ihavethis) 
THEN 
  974            kind_type_tmp(nk) = ikind
 
  975            kind_z_tmp(nk) = int(zatom)
 
  976            xas_env%mykind_of_atom(iat) = nk
 
  977            xas_env%mykind_of_kind(ikind) = nk
 
  981      ALLOCATE (xas_env%my_gto_basis(nk))
 
  982      ALLOCATE (xas_env%stogto_overlap(nk))
 
  984         NULLIFY (xas_env%my_gto_basis(ik)%gto_basis_set, sto_basis_set)
 
  989               ne(l, i) = 
ptable(kind_z_tmp(ik))%e_conv(l - 1) - 2*nj*(i - l)
 
  990               ne(l, i) = max(ne(l, i), 0)
 
  991               ne(l, i) = min(ne(l, i), 2*nj)
 
  995         sto_zet(1) = 
srules(kind_z_tmp(ik), ne, nq(1), lq(1))
 
  997         name_sto = 
'xas_tmp_sto' 
  999                                lq=lq, zet=sto_zet, name=name_sto)
 
 1001                                        xas_env%my_gto_basis(ik)%gto_basis_set, 
xas_control%ngauss)
 
 1003         xas_env%my_gto_basis(ik)%gto_basis_set%norm_type = 2
 
 1006         ikind = kind_type_tmp(ik)
 
 1007         CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set)
 
 1010         CALL get_gto_basis_set(gto_basis_set=xas_env%my_gto_basis(ik)%gto_basis_set, nsgf=nsgf_sto)
 
 1011         ALLOCATE (xas_env%stogto_overlap(ik)%array(nsgf_sto, nsgf_gto))
 
 1014                                  xas_env%stogto_overlap(ik)%array)
 
 1017      DEALLOCATE (nq, lq, sto_zet)
 
 1018      DEALLOCATE (kind_type_tmp, kind_z_tmp)
 
 1020   END SUBROUTINE xas_env_init
 
 1038   SUBROUTINE cls_calculate_spectrum(xas_control, xas_env, qs_env, xas_section, &
 
 1045      INTEGER, 
INTENT(IN)                                :: iatom, istate
 
 1047      INTEGER                                            :: homo, i, lfomo, my_spin, nabs, nmo, &
 
 1048                                                            nvirtual, output_unit, xas_estate
 
 1049      LOGICAL                                            :: append_cube, length
 
 1051      REAL(
dp), 
DIMENSION(:), 
POINTER                    :: all_evals
 
 1052      REAL(
dp), 
DIMENSION(:, :), 
POINTER                 :: sp_ab, sp_em
 
 1053      TYPE(
cp_fm_type), 
DIMENSION(:, :), 
POINTER         :: dip_fm_set
 
 1054      TYPE(
cp_fm_type), 
POINTER                          :: all_vectors, excvec_coeff
 
 1056      TYPE(
dbcsr_p_type), 
DIMENSION(:), 
POINTER          :: op_sm, ostrength_sm
 
 1064      NULLIFY (ostrength_sm, op_sm, dip_fm_set)
 
 1065      NULLIFY (all_evals, all_vectors, excvec_coeff)
 
 1066      NULLIFY (mos, particle_set, sp_em, sp_ab)
 
 1070                      mos=mos, particle_set=particle_set)
 
 1072      CALL get_xas_env(xas_env=xas_env, all_vectors=all_vectors, xas_estate=xas_estate, &
 
 1073                       all_evals=all_evals, dip_fm_set=dip_fm_set, excvec_coeff=excvec_coeff, &
 
 1074                       ostrength_sm=ostrength_sm, nvirtual=nvirtual, spin_channel=my_spin)
 
 1075      CALL get_mo_set(mos(my_spin), homo=homo, lfomo=lfomo, nmo=nmo)
 
 1077      nabs = nvirtual - lfomo + 1
 
 1078      ALLOCATE (sp_em(6, homo))
 
 1079      ALLOCATE (sp_ab(6, nabs))
 
 1080      cpassert(
ASSOCIATED(excvec_coeff))
 
 1085            rc(1:3) = particle_set(iatom)%r(1:3)
 
 1087               NULLIFY (op_sm(i)%matrix)
 
 1088               op_sm(i)%matrix => ostrength_sm(i)%matrix
 
 1090            CALL rrc_xyz_ao(op_sm, qs_env, rc, order=1, minimum_image=.true.)
 
 1091            CALL spectrum_dip_vel(dip_fm_set, op_sm, mos, excvec_coeff, &
 
 1092                                  all_vectors, all_evals, &
 
 1093                                  sp_em, sp_ab, xas_estate, nvirtual, my_spin)
 
 1094            DO i = 1, 
SIZE(ostrength_sm, 1)
 
 1095               CALL dbcsr_set(ostrength_sm(i)%matrix, 0.0_dp)
 
 1099               NULLIFY (op_sm(i)%matrix)
 
 1100               op_sm(i)%matrix => ostrength_sm(i)%matrix
 
 1102            CALL spectrum_dip_vel(dip_fm_set, op_sm, mos, excvec_coeff, &
 
 1103                                  all_vectors, all_evals, &
 
 1104                                  sp_em, sp_ab, xas_estate, nvirtual, my_spin)
 
 1112         CALL xas_write(sp_em, sp_ab, xas_estate, &
 
 1113                        xas_section, iatom, istate, lfomo, length=length)
 
 1120                                           "PRINT%CLS_FUNCTION_CUBES"), 
cp_p_file)) 
THEN 
 1121         append_cube = 
section_get_lval(xas_section, 
"PRINT%CLS_FUNCTION_CUBES%APPEND")
 
 1122         CALL xas_print_cubes(
xas_control, qs_env, xas_section, mos, all_vectors, &
 
 1128         CALL xas_pdos(qs_env, xas_section, mos, iatom)
 
 1133   END SUBROUTINE cls_calculate_spectrum
 
 1151   SUBROUTINE xas_write(sp_em, sp_ab, estate, xas_section, iatom, state_to_be_excited, &
 
 1154      REAL(
dp), 
DIMENSION(:, :), 
POINTER                 :: sp_em, sp_ab
 
 1155      INTEGER, 
INTENT(IN)                                :: estate
 
 1157      INTEGER, 
INTENT(IN)                                :: iatom, state_to_be_excited, lfomo
 
 1158      LOGICAL, 
INTENT(IN)                                :: length
 
 1160      CHARACTER(LEN=default_string_length)               :: mittle_ab, mittle_em, my_act, my_pos
 
 1161      INTEGER                                            :: i, istate, out_sp_ab, out_sp_em
 
 1174                                       extension=
".spectrum", file_position=my_pos, file_action=my_act, &
 
 1175                                       file_form=
"FORMATTED", middle_name=trim(mittle_em))
 
 1177      IF (out_sp_em > 0) 
THEN 
 1178         WRITE (out_sp_em, 
'(A,I6,A,I6,A,I6)') 
" Emission spectrum for atom ", iatom, &
 
 1179            ", index of excited core MO is", estate, 
", # of lines ", 
SIZE(sp_em, 2)
 
 1181         DO istate = estate, 
SIZE(sp_em, 2)
 
 1182            IF (length) ene2 = sp_em(1, istate)*sp_em(1, istate)
 
 1183            WRITE (out_sp_em, 
'(I6,5F16.8,F10.5)') istate, sp_em(1, istate)*
evolt, &
 
 1184               sp_em(2, istate)*ene2, sp_em(3, istate)*ene2, &
 
 1185               sp_em(4, istate)*ene2, sp_em(5, istate)*ene2, sp_em(6, istate)
 
 1189                                        "PRINT%XES_SPECTRUM")
 
 1193                                       extension=
".spectrum", file_position=my_pos, file_action=my_act, &
 
 1194                                       file_form=
"FORMATTED", middle_name=trim(mittle_ab))
 
 1196      IF (out_sp_ab > 0) 
THEN 
 1197         WRITE (out_sp_ab, 
'(A,I6,A,I6,A,I6)') 
" Absorption spectrum for atom ", iatom, &
 
 1198            ", index of excited core MO is", estate, 
", # of lines ", 
SIZE(sp_ab, 2)
 
 1200         DO i = 1, 
SIZE(sp_ab, 2)
 
 1201            istate = lfomo - 1 + i
 
 1202            IF (length) ene2 = sp_ab(1, i)*sp_ab(1, i)
 
 1203            WRITE (out_sp_ab, 
'(I6,5F16.8,F10.5)') istate, sp_ab(1, i)*
evolt, &
 
 1204               sp_ab(2, i)*ene2, sp_ab(3, i)*ene2, &
 
 1205               sp_ab(4, i)*ene2, sp_ab(5, i)*ene2, sp_ab(6, i)
 
 1210                                        "PRINT%XAS_SPECTRUM")
 
 1212   END SUBROUTINE xas_write
 
 1227   SUBROUTINE xas_print_cubes(xas_control, qs_env, xas_section, &
 
 1228                              mos, all_vectors, iatom, append_cube)
 
 1233      TYPE(
mo_set_type), 
DIMENSION(:), 
INTENT(IN)        :: mos
 
 1235      INTEGER, 
INTENT(IN)                                :: iatom
 
 1236      LOGICAL, 
INTENT(IN)                                :: append_cube
 
 1238      CHARACTER(LEN=default_string_length)               :: my_mittle, my_pos
 
 1239      INTEGER                                            :: homo, istate0, my_spin, nspins, nstates
 
 1240      REAL(
dp), 
DIMENSION(:, :), 
POINTER                 :: centers
 
 1252         ALLOCATE (centers(6, nstates))
 
 1261      IF (append_cube) 
THEN 
 1266                          centers, print_key, my_mittle, state0=istate0, file_position=my_pos)
 
 1268      DEALLOCATE (centers)
 
 1270   END SUBROUTINE xas_print_cubes
 
 1283   SUBROUTINE xas_pdos(qs_env, xas_section, mos, iatom)
 
 1287      TYPE(
mo_set_type), 
DIMENSION(:), 
INTENT(IN)        :: mos
 
 1288      INTEGER, 
INTENT(IN)                                :: iatom
 
 1290      CHARACTER(LEN=default_string_length)               :: xas_mittle
 
 1294      TYPE(
qs_kind_type), 
DIMENSION(:), 
POINTER          :: qs_kind_set
 
 1296      NULLIFY (atomic_kind_set, particle_set, qs_kind_set)
 
 1297      xas_mittle = 
'xasat'//trim(adjustl(
cp_to_string(iatom)))//
'_' 
 1300                      atomic_kind_set=atomic_kind_set, &
 
 1301                      particle_set=particle_set, &
 
 1302                      qs_kind_set=qs_kind_set)
 
 1306                                      xas_section, ispin, xas_mittle)
 
 1309   END SUBROUTINE xas_pdos
 
 1333   SUBROUTINE spectrum_dip_vel(fm_set, op_sm, mos, excvec, &
 
 1334                               all_vectors, all_evals, sp_em, sp_ab, estate, nstate, my_spin)
 
 1336      TYPE(
cp_fm_type), 
DIMENSION(:, :), 
POINTER         :: fm_set
 
 1338      TYPE(
mo_set_type), 
DIMENSION(:), 
INTENT(IN)        :: mos
 
 1339      TYPE(
cp_fm_type), 
INTENT(IN)                       :: excvec, all_vectors
 
 1340      REAL(
dp), 
DIMENSION(:), 
POINTER                    :: all_evals
 
 1341      REAL(
dp), 
DIMENSION(:, :), 
POINTER                 :: sp_em, sp_ab
 
 1342      INTEGER, 
INTENT(IN)                                :: estate, nstate, my_spin
 
 1344      INTEGER                                            :: homo, i, i_abs, istate, lfomo, nao, nmo
 
 1345      REAL(
dp)                                           :: dip(3), ene_f, ene_i
 
 1346      REAL(
dp), 
DIMENSION(:), 
POINTER                    :: eigenvalues, occupation_numbers
 
 1349      cpassert(
ASSOCIATED(fm_set))
 
 1350      NULLIFY (eigenvalues, occupation_numbers)
 
 1352      CALL get_mo_set(mos(my_spin), eigenvalues=eigenvalues, occupation_numbers=occupation_numbers, &
 
 1353                      nao=nao, nmo=nmo, homo=homo, lfomo=lfomo)
 
 1356      DO i = 1, 
SIZE(fm_set, 2)
 
 1360         CALL parallel_gemm(
"T", 
"N", 1, nstate, nao, 1.0_dp, excvec, &
 
 1361                            fm_work, 0.0_dp, fm_set(my_spin, i), b_first_col=1)
 
 1367      ene_i = eigenvalues(estate)
 
 1368      DO istate = 1, nstate
 
 1369         ene_f = all_evals(istate)
 
 1373         IF (istate <= homo) 
THEN 
 1374            sp_em(1, istate) = ene_f - ene_i
 
 1375            sp_em(2, istate) = dip(1)
 
 1376            sp_em(3, istate) = dip(2)
 
 1377            sp_em(4, istate) = dip(3)
 
 1378            sp_em(5, istate) = dip(1)*dip(1) + dip(2)*dip(2) + dip(3)*dip(3)
 
 1379            sp_em(6, istate) = occupation_numbers(istate)
 
 1381         IF (istate >= lfomo) 
THEN 
 1382            i_abs = istate - lfomo + 1
 
 1383            sp_ab(1, i_abs) = ene_f - ene_i
 
 1384            sp_ab(2, i_abs) = dip(1)
 
 1385            sp_ab(3, i_abs) = dip(2)
 
 1386            sp_ab(4, i_abs) = dip(3)
 
 1387            sp_ab(5, i_abs) = dip(1)*dip(1) + dip(2)*dip(2) + dip(3)*dip(3)
 
 1388            IF (istate <= nmo) sp_ab(6, i_abs) = occupation_numbers(istate)
 
 1393   END SUBROUTINE spectrum_dip_vel
 
 1404      REAL(
dp), 
DIMENSION(:, :), 
POINTER                 :: matrix
 
 1406      INTEGER                                            :: iset, jset, ldsab, maxcoa, maxcob, maxl, &
 
 1407                                                            maxla, maxlb, na, nb, nseta, nsetb, &
 
 1408                                                            nsgfa, nsgfb, sgfa, sgfb
 
 1409      INTEGER, 
DIMENSION(:), 
POINTER                     :: la_max, la_min, lb_max, lb_min, npgfa, &
 
 1410                                                            npgfb, nsgfa_set, nsgfb_set
 
 1411      INTEGER, 
DIMENSION(:, :), 
POINTER                  :: first_sgfa, first_sgfb
 
 1413      REAL(
dp), 
ALLOCATABLE, 
DIMENSION(:, :)             :: sab, work
 
 1414      REAL(kind=
dp), 
DIMENSION(:, :), 
POINTER            :: rpgfa, rpgfb, scon_a, scon_b, sphi_a, &
 
 1417      NULLIFY (la_max, la_min, lb_max, lb_min)
 
 1418      NULLIFY (npgfa, npgfb, nsgfa_set, nsgfb_set)
 
 1419      NULLIFY (first_sgfa, first_sgfb)
 
 1420      NULLIFY (rpgfa, rpgfb, sphi_a, sphi_b, zeta, zetb)
 
 1422      CALL get_gto_basis_set(gto_basis_set=base_a, nsgf=nsgfa, nsgf_set=nsgfa_set, lmax=la_max, &
 
 1423                             lmin=la_min, npgf=npgfa, pgf_radius=rpgfa, &
 
 1424                             sphi=sphi_a, scon=scon_a, zet=zeta, first_sgf=first_sgfa, &
 
 1425                             maxco=maxcoa, nset=nseta, maxl=maxla)
 
 1427      CALL get_gto_basis_set(gto_basis_set=base_b, nsgf=nsgfb, nsgf_set=nsgfb_set, lmax=lb_max, &
 
 1428                             lmin=lb_min, npgf=npgfb, pgf_radius=rpgfb, &
 
 1429                             sphi=sphi_b, scon=scon_b, zet=zetb, first_sgf=first_sgfb, &
 
 1430                             maxco=maxcob, nset=nsetb, maxl=maxlb)
 
 1435      ldsab = max(maxcoa, maxcob, nsgfa, nsgfb)
 
 1436      maxl = max(maxla, maxlb)
 
 1438      ALLOCATE (sab(ldsab, ldsab))
 
 1439      ALLOCATE (work(ldsab, ldsab))
 
 1443         na = npgfa(iset)*(
ncoset(la_max(iset)) - 
ncoset(la_min(iset) - 1))
 
 1444         sgfa = first_sgfa(1, iset)
 
 1447            nb = npgfb(jset)*(
ncoset(lb_max(jset)) - 
ncoset(lb_min(jset) - 1))
 
 1448            sgfb = first_sgfb(1, jset)
 
 1450            CALL overlap_ab(la_max(iset), la_min(iset), npgfa(iset), rpgfa(:, iset), zeta(:, iset), &
 
 1451                            lb_max(jset), lb_min(jset), npgfb(jset), rpgfb(:, jset), zetb(:, jset), &
 
 1453            CALL contraction(sab, work, ca=scon_a(:, sgfa:), na=na, ma=nsgfa_set(iset), &
 
 1454                             cb=scon_b(:, sgfb:), nb=nb, mb=nsgfb_set(jset))
 
 1455            CALL block_add(
"IN", work, nsgfa_set(iset), nsgfb_set(jset), matrix, sgfa, sgfb)
 
 1459      DEALLOCATE (sab, work)
 
 
 1482   SUBROUTINE cls_assign_core_states(xas_control, xas_env, localized_wfn_control, qs_env)
 
 1489      INTEGER                                            :: chosen_state, homo, i, iat, iatom, &
 
 1490                                                            ikind, isgf, istate, j, my_kind, &
 
 1491                                                            my_spin, nao, natom, nexc_atoms, &
 
 1492                                                            nexc_search, output_unit
 
 1493      INTEGER, 
ALLOCATABLE, 
DIMENSION(:)                 :: first_sgf
 
 1494      INTEGER, 
DIMENSION(3)                              :: perd0
 
 1495      INTEGER, 
DIMENSION(:), 
POINTER                     :: atom_of_state, mykind_of_kind, &
 
 1496                                                            nexc_states, state_of_mytype, &
 
 1498      INTEGER, 
DIMENSION(:, :), 
POINTER                  :: state_of_atom
 
 1499      REAL(
dp)                                           :: component, dist, distmin, maxocc, ra(3), &
 
 1501      REAL(
dp), 
DIMENSION(:), 
POINTER                    :: max_overlap, sto_state_overlap
 
 1502      REAL(
dp), 
DIMENSION(:, :), 
POINTER                 :: centers_wfn
 
 1503      REAL(kind=
dp), 
DIMENSION(:, :), 
POINTER            :: vecbuffer
 
 1511      TYPE(
qs_kind_type), 
DIMENSION(:), 
POINTER          :: qs_kind_set
 
 1513      NULLIFY (cell, mos, particle_set)
 
 1514      NULLIFY (atom_of_state, centers_wfn, mykind_of_kind, state_of_atom, nexc_states)
 
 1515      NULLIFY (stogto_overlap, type_of_state, max_overlap, qs_kind_set)
 
 1516      NULLIFY (state_of_mytype, type_of_state, sto_state_overlap)
 
 1522      CALL get_qs_env(qs_env=qs_env, cell=cell, mos=mos, particle_set=particle_set, &
 
 1523                      qs_kind_set=qs_kind_set)
 
 1527      perd0(1:3) = cell%perd(1:3)
 
 1531                       centers_wfn=centers_wfn, atom_of_state=atom_of_state, &
 
 1532                       mykind_of_kind=mykind_of_kind, &
 
 1533                       type_of_state=type_of_state, state_of_atom=state_of_atom, &
 
 1534                       stogto_overlap=stogto_overlap, nexc_atoms=nexc_atoms, &
 
 1535                       spin_channel=my_spin, nexc_search=nexc_search, nexc_states=nexc_states)
 
 1537      CALL get_mo_set(mos(my_spin), mo_coeff=mo_coeff, maxocc=maxocc, nao=nao, homo=homo)
 
 1540      ALLOCATE (vecbuffer(1, nao))
 
 1541      natom = 
SIZE(particle_set)
 
 1543      ALLOCATE (first_sgf(natom))
 
 1545      ALLOCATE (sto_state_overlap(nexc_search))
 
 1546      ALLOCATE (max_overlap(natom))
 
 1547      max_overlap = 0.0_dp
 
 1548      ALLOCATE (state_of_mytype(natom))
 
 1556         DO istate = 1, nexc_search
 
 1557            centers_wfn(1, istate) = localized_wfn_control%centers_set(my_spin)%array(1, istate)
 
 1558            centers_wfn(2, istate) = localized_wfn_control%centers_set(my_spin)%array(2, istate)
 
 1559            centers_wfn(3, istate) = localized_wfn_control%centers_set(my_spin)%array(3, istate)
 
 1563            DO iat = 1, nexc_atoms
 
 1565               ra(1:3) = particle_set(iatom)%r(1:3)
 
 1566               rc(1:3) = centers_wfn(1:3, istate)
 
 1567               rac = 
pbc(ra, rc, cell)
 
 1568               dist = rac(1)*rac(1) + rac(2)*rac(2) + rac(3)*rac(3)
 
 1570               IF (dist < distmin) 
THEN 
 1572                  atom_of_state(istate) = iatom
 
 1576            IF (atom_of_state(istate) /= 0) 
THEN 
 1579                                        nao, 1, transpose=.true.)
 
 1581               iatom = atom_of_state(istate)
 
 1583               NULLIFY (atomic_kind)
 
 1584               atomic_kind => particle_set(iatom)%atomic_kind
 
 1588               my_kind = mykind_of_kind(ikind)
 
 1590               sto_state_overlap(istate) = 0.0_dp
 
 1591               DO i = 1, 
SIZE(stogto_overlap(my_kind)%array, 1)
 
 1593                  DO j = 1, 
SIZE(stogto_overlap(my_kind)%array, 2)
 
 1594                     isgf = first_sgf(iatom) + j - 1
 
 1595                     component = component + stogto_overlap(my_kind)%array(i, j)*vecbuffer(1, isgf)
 
 1597                  sto_state_overlap(istate) = sto_state_overlap(istate) + &
 
 1601               IF (sto_state_overlap(istate) > max_overlap(iatom)) 
THEN 
 1602                  state_of_mytype(iatom) = istate
 
 1603                  max_overlap(iatom) = sto_state_overlap(istate)
 
 1610            DO iat = 1, nexc_atoms
 
 1612               DO istate = 1, nexc_search
 
 1613                  IF (atom_of_state(istate) == iatom) 
THEN 
 1614                     IF (sto_state_overlap(istate) > max_overlap(iatom)*
xas_control%overlap_threshold &
 
 1615                         .AND. istate /= state_of_mytype(iat)) 
THEN 
 1616                        nexc_states(iat) = nexc_states(iat) + 1
 
 1617                        state_of_atom(iat, nexc_states(iat)) = istate
 
 1625         IF (output_unit > 0) 
THEN 
 1626            WRITE (unit=output_unit, fmt=
"(/,T10,A,/)") &
 
 1627               "List the atoms to be excited and the relative of MOs index " 
 1630         DO iat = 1, nexc_atoms
 
 1631            iatom = xas_env%exc_atoms(iat)
 
 1632            state_of_atom(iat, 1) = state_of_mytype(iatom) 
 
 1633            IF (output_unit > 0) 
THEN 
 1634               WRITE (unit=output_unit, fmt=
"(T10,A,I3,T26,A)", advance=
'NO') &
 
 1635                  'Atom: ', iatom, 
"MO index:" 
 1637            DO istate = 1, nexc_states(iat)
 
 1638               IF (istate < nexc_states(iat)) 
THEN 
 1639                  IF (output_unit > 0) 
WRITE (unit=output_unit, fmt=
"(I4)", advance=
'NO') state_of_atom(iat, istate)
 
 1641                  IF (output_unit > 0) 
WRITE (unit=output_unit, fmt=
"(I4)") state_of_atom(iat, istate)
 
 1644            IF (state_of_atom(iat, 1) == 0 .OR. state_of_atom(iat, 1) .GT. homo) 
THEN 
 1645               cpabort(
"A wrong state has been selected for excitation, check the Wannier centers")
 
 1650            DO iat = 1, nexc_atoms
 
 1651               IF (output_unit > 0) 
THEN 
 1652                  WRITE (unit=output_unit, fmt=
"(/,T10,A,I6)") &
 
 1653                     'Overlap integrals for Atom: ', iat
 
 1654                  DO istate = 1, nexc_states(iat)
 
 1655                     WRITE (unit=output_unit, fmt=
"(T10,A,I3,T26,A,T38,f10.8)") &
 
 1656                        'State: ', state_of_atom(iat, istate), 
"Overlap:", sto_state_overlap(state_of_atom(iat, istate))
 
 1662         CALL reallocate(xas_env%state_of_atom, 1, nexc_atoms, 1, maxval(nexc_states)) 
 
 1667         CALL reallocate(xas_env%nexc_states, 1, natom)
 
 1669         CALL get_xas_env(xas_env, nexc_states=nexc_states, state_of_atom=state_of_atom)
 
 1679            centers_wfn(1, chosen_state) = localized_wfn_control%centers_set(my_spin)%array(1, chosen_state)
 
 1680            centers_wfn(2, chosen_state) = localized_wfn_control%centers_set(my_spin)%array(2, chosen_state)
 
 1681            centers_wfn(3, chosen_state) = localized_wfn_control%centers_set(my_spin)%array(3, chosen_state)
 
 1685               ra(1:3) = particle_set(iat)%r(1:3)
 
 1686               rc(1:3) = centers_wfn(1:3, chosen_state)
 
 1687               rac = 
pbc(ra, rc, cell)
 
 1688               dist = rac(1)*rac(1) + rac(2)*rac(2) + rac(3)*rac(3)
 
 1689               IF (dist < distmin) 
THEN 
 1690                  atom_of_state(chosen_state) = iat 
 
 1695            nexc_states(atom_of_state(chosen_state)) = nexc_states(atom_of_state(chosen_state)) + 1
 
 1696            state_of_atom(atom_of_state(chosen_state), nexc_states(atom_of_state(chosen_state))) = chosen_state
 
 1701         IF (output_unit > 0) 
THEN 
 1702            WRITE (unit=output_unit, fmt=
"(/,T10,A,/)") &
 
 1703               "List the atoms to be excited and the relative of MOs index " 
 1707            IF (output_unit > 0 .AND. state_of_atom(iat, 1) /= 0) 
THEN 
 1708               WRITE (unit=output_unit, fmt=
"(T10,A,I3,T26,A)", advance=
'NO') &
 
 1709                  'Atom: ', iat, 
"MO index:" 
 1710               DO i = 1, nexc_states(iat)
 
 1711                  IF (i < nexc_states(iat)) 
THEN 
 1712                     WRITE (unit=output_unit, fmt=
"(I4)", advance=
'NO') state_of_atom(iat, i)
 
 1714                     WRITE (unit=output_unit, fmt=
"(I4)") state_of_atom(iat, i)
 
 1718            IF (state_of_atom(iat, 1) .GT. homo) 
THEN 
 1719               cpabort(
"A wrong state has been selected for excitation, check the Wannier centers")
 
 1723         CALL reallocate(xas_env%state_of_atom, 1, natom, 1, maxval(nexc_states)) 
 
 1728      cell%perd(1:3) = perd0(1:3)
 
 1730      DEALLOCATE (vecbuffer)
 
 1731      DEALLOCATE (first_sgf)
 
 1732      DEALLOCATE (sto_state_overlap)
 
 1733      DEALLOCATE (max_overlap)
 
 1734      DEALLOCATE (state_of_mytype)
 
 1736   END SUBROUTINE cls_assign_core_states
 
Set of routines to: Contract integrals over primitive Gaussians Decontract (density) matrices Trace m...
Calculation of the overlap integrals over Cartesian Gaussian-type functions.
subroutine, public overlap_ab(la_max, la_min, npgfa, rpgfa, zeta, lb_max, lb_min, npgfb, rpgfb, zetb, rab, sab, dab, ddab)
Calculation of the two-center overlap integrals [a|b] over Cartesian Gaussian-type functions....
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.
subroutine, public get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, npgf_sum, nshell_sum, maxder, short_kind_radius, npgf_seg_sum)
...
pure real(dp) function, public srules(z, ne, n, l)
...
subroutine, public deallocate_sto_basis_set(sto_basis_set)
...
subroutine, public allocate_sto_basis_set(sto_basis_set)
...
subroutine, public create_gto_from_sto_basis(sto_basis_set, gto_basis_set, ngauss, ortho)
...
subroutine, public set_sto_basis_set(sto_basis_set, name, nshell, symbol, nq, lq, zet)
...
subroutine, public init_orb_basis_set(gto_basis_set)
Initialise a Gaussian-type orbital (GTO) basis set data set.
Handles all functions related to the CELL.
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_set(matrix, alpha)
...
Routines that link DBCSR and CP2K concepts together.
subroutine, public cp_dbcsr_alloc_block_from_nbl(matrix, sab_orb, desymmetrize)
allocate the blocks of a dbcsr based on the neighbor list
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
Routines to handle the external control of CP2K.
subroutine, public external_control(should_stop, flag, globenv, target_time, start_time, force_check)
External manipulations during a run : when the <PROJECT_NAME>.EXIT_$runtype command is sent the progr...
pool for for elements that are retained and released
subroutine, public fm_pool_create_fm(pool, element, name)
returns an element, allocating it if none is in the pool
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
subroutine, public cp_fm_get_element(matrix, irow_global, icol_global, alpha, local)
returns an element of a fm this value is valid on every cpu using this call is expensive
subroutine, public cp_fm_set_submatrix(fm, new_values, start_row, start_col, n_rows, n_cols, alpha, beta, transpose)
sets a submatrix of a full matrix fm(start_row:start_row+n_rows,start_col:start_col+n_cols) = alpha*o...
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
subroutine, public cp_fm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
gets a submatrix of a full matrix op(target_m)(1:n_rows,1:n_cols) =fm(start_row:start_row+n_rows,...
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
various routines to log and control the output. The idea is that decisions about where to log should ...
integer function, public cp_logger_get_default_io_unit(logger)
returns the unit nr for the ionode (-1 on all other processors) skips as well checks if the procs cal...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Utility routines for the memory handling.
Interface to the message passing library MPI.
Provides Cartesian and spherical orbital pointers and indices.
integer, dimension(:), allocatable, public ncoset
basic linear algebra operations for full matrixes
Define methods related to particle_type.
subroutine, public get_particle_set(particle_set, qs_kind_set, first_sgf, last_sgf, nsgf, nmao, basis)
Get the components of a particle set.
Define the data structure for the particle information.
Periodic Table related data definitions.
type(atom), dimension(0:nelem), public ptable
Definition of physical constants:
real(kind=dp), parameter, public evolt
Apply the direct inversion in the iterative subspace (DIIS) of Pulay in the framework of an SCF itera...
pure subroutine, public qs_diis_b_clear(diis_buffer)
clears the buffer
subroutine, public qs_diis_b_create(diis_buffer, nbuffer)
Allocates an SCF DIIS buffer.
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
subroutine, public set_qs_env(qs_env, super_cell, mos, qmmm, qmmm_periodic, ewald_env, ewald_pw, mpools, rho_external, external_vxc, mask, scf_control, rel_control, qs_charges, ks_env, ks_qmmm_env, wf_history, scf_env, active_space, input, oce, rho_atom_set, rho0_atom_set, rho0_mpole, run_rtp, rtp, rhoz_set, rhoz_tot, ecoul_1c, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, efield, rhoz_cneo_set, linres_control, xas_env, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, ls_scf_env, do_transport, transport_env, lri_env, lri_density, exstate_env, ec_env, dispersion_env, harris_env, gcp_env, mp2_env, bs_env, kg_env, force, kpoints, wanniercentres, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Set the QUICKSTEP environment.
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, cneo_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
Driver for the localization that should be general for all the methods available and all the definiti...
subroutine, public qs_loc_driver(qs_env, qs_loc_env, print_loc_section, myspin, ext_mo_coeff)
set up the calculation of localized orbitals
Driver for the localization that should be general for all the methods available and all the definiti...
subroutine, public qs_print_cubes(qs_env, mo_coeff, nstates, state_list, centers, print_key, root, ispin, idir, state0, file_position)
write the cube files for a set of selected states
New version of the module for the localization of the molecular orbitals This should be able to use d...
subroutine, public qs_loc_env_create(qs_loc_env)
...
Some utilities for the construction of the localization environment.
subroutine, public set_loc_wfn_lists(localized_wfn_control, nmoloc, nmo, nspins, my_spin)
create the lists of mos that are taken into account
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 set_loc_centers(localized_wfn_control, nmoloc, nspins)
create the center and spread array and the file names for the output
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
wrapper for the pools of matrixes
subroutine, public mpools_get(mpools, ao_mo_fm_pools, ao_ao_fm_pools, mo_mo_fm_pools, ao_mosub_fm_pools, mosub_mosub_fm_pools, maxao_maxmo_fm_pool, maxao_maxao_fm_pool, maxmo_maxmo_fm_pool)
returns various attributes of the mpools (notably the pools contained in it)
Definition and initialisation of the mo data type.
subroutine, public write_mo_set_to_output_unit(mo_set, qs_kind_set, particle_set, dft_section, before, kpoint, final_mos, spin, solver_method, rtp, cpart, sim_step, umo_set)
Write MO information to output file (eigenvalues, occupation numbers, coefficients)
collects routines that perform operations directly related to MOs
Definition and initialisation of the mo data type.
subroutine, public set_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, uniform_occupation, kts, mu, flexible_electron_count)
Set the components of a MO set data structure.
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
Define the neighbor list data types and the corresponding functionality.
subroutine, public p_xyz_ao(op, qs_env, minimum_image)
Calculation of the components of the dipole operator in the velocity form The elements of the sparse ...
subroutine, public rrc_xyz_ao(op, qs_env, rc, order, minimum_image, soft)
Calculation of the components of the dipole operator in the length form by taking the relative positi...
Calculation and writing of projected density of states The DOS is computed per angular momentum and p...
subroutine, public calculate_projected_dos(mo_set, atomic_kind_set, qs_kind_set, particle_set, qs_env, dft_section, ispin, xas_mittle, external_matrix_shalf)
Compute and write projected density of states.
Utility routines for qs_scf.
subroutine, public qs_scf_env_initialize(qs_env, scf_env, scf_control, scf_section)
initializes input parameters if needed or restores values from previous runs to fill scf_env with the...
module that contains the definitions of the scf types
subroutine, public scf_env_release(scf_env)
releases an scf_env (see doc/ReferenceCounting.html)
Routines for the Quickstep SCF run.
subroutine, public scf_env_cleanup(scf_env)
perform cleanup operations (like releasing temporary storage) at the end of the scf
parameters that control an scf iteration
subroutine, public scf_c_read_parameters(scf_control, inp_section)
reads the parameters of the scf section into the given scf_control
subroutine, public scf_c_create(scf_control)
allocates and initializes an scf control object with the default values
Defines control structures, which contain the parameters and the settings for the calculations.
subroutine, public read_xas_control(xas_control, xas_section)
read from input the instructions for a xes/xas calculation
subroutine, public xas_control_create(xas_control)
create retain release the xas_control_type
subroutine, public write_xas_control(xas_control, dft_section)
write on the instructions for a xes/xas calculation
define create destroy get and put information in xas_env to calculate the x-ray absorption spectra
subroutine, public xas_env_release(xas_env)
...
subroutine, public set_xas_env(xas_env, nexc_search, spin_channel, nexc_atoms, nvirtual, nvirtual2, ip_energy, occ_estate, qs_loc_env, xas_estate, xas_nelectron, homo_occ, scf_env, scf_control)
...
subroutine, public xas_env_create(xas_env)
...
subroutine, public get_xas_env(xas_env, exc_state, nao, nvirtual, nvirtual2, centers_wfn, atom_of_state, exc_atoms, nexc_states, type_of_state, mykind_of_atom, mykind_of_kind, state_of_atom, spectrum, groundstate_coeff, ostrength_sm, dip_fm_set, excvec_coeff, excvec_overlap, unoccupied_orbs, unoccupied_evals, unoccupied_max_iter, unoccupied_eps, all_vectors, all_evals, my_gto_basis, qs_loc_env, stogto_overlap, occ_estate, xas_nelectron, xas_estate, nexc_atoms, nexc_search, spin_channel, scf_env, scf_control)
...
driver for the xas calculation and xas_scf for the tp method
subroutine, public calc_stogto_overlap(base_a, base_b, matrix)
...
subroutine, public xas(qs_env, dft_control)
Driver for xas calculations The initial mos are prepared A loop on the atoms to be excited is started...
Initialize the XAS orbitals for specific core excitations Either the GS orbitals are used as initial ...
subroutine, public xas_read_restart(xas_env, xas_section, qs_env, xas_method, iatom, estate, istate)
Set up for reading the restart corresponding to the excitation of iatom If the corresponding restart ...
xas_scf for the tp method It is repeaated for every atom that have to be excited
subroutine, public xas_do_tp_scf(dft_control, xas_env, iatom, istate, scf_env, qs_env, xas_section, scf_section, converged, should_stop)
perform an scf loop to calculate the xas spectrum given by the excitation of a inner state of a selec...
subroutine, public xes_scf_once(qs_env, xas_env, converged, should_stop)
SCF for emission spectra calculations: vacancy in valence.
Provides all information about an atomic kind.
Type defining parameters related to the simulation cell.
represent a pointer to a 2d array
keeps the information about the structure of a full matrix
type of a logger, at the moment it contains just a print level starting at which level it should be l...
stores all the informations relevant to an mpi environment
Provides all information about a quickstep kind.
A type that holds controlling information for the calculation of the spread of wfn and the optimizati...
contains all the info needed by quickstep to calculate the spread of a selected set of orbitals and i...
container for the pools of matrixes used by qs
A type that holds controlling information for a xas calculation.