LCOV - code coverage report
Current view: top level - src - qs_loc_main.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 79.9 % 229 183
Test Date: 2025-07-25 12:55:17 Functions: 100.0 % 3 3

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief Driver for the localization that should be general
      10              : !>      for all the methods available and all the definition of the
      11              : !>      spread functional
      12              : !>      Write centers, spread and cubes only if required and for the
      13              : !>      selected states
      14              : !>      The localized functions are copied in the standard mos array
      15              : !>      for the next use
      16              : !> \par History
      17              : !>      01.2008 Teodoro Laino [tlaino] - University of Zurich
      18              : !>        - Merging the two localization codes and updating to new structures
      19              : !>      04.2023 JGH Code isolation and refactoring
      20              : !> \author MI (04.2005)
      21              : ! **************************************************************************************************
      22              : MODULE qs_loc_main
      23              :    USE atomic_kind_types,               ONLY: atomic_kind_type
      24              :    USE cell_types,                      ONLY: cell_type
      25              :    USE cp_control_types,                ONLY: dft_control_type
      26              :    USE cp_dbcsr_api,                    ONLY: dbcsr_create,&
      27              :                                               dbcsr_p_type,&
      28              :                                               dbcsr_set,&
      29              :                                               dbcsr_type,&
      30              :                                               dbcsr_type_symmetric
      31              :    USE cp_dbcsr_cp2k_link,              ONLY: cp_dbcsr_alloc_block_from_nbl
      32              :    USE cp_dbcsr_operations,             ONLY: cp_dbcsr_sm_fm_multiply,&
      33              :                                               dbcsr_allocate_matrix_set,&
      34              :                                               dbcsr_deallocate_matrix_set
      35              :    USE cp_fm_struct,                    ONLY: cp_fm_struct_create,&
      36              :                                               cp_fm_struct_release,&
      37              :                                               cp_fm_struct_type
      38              :    USE cp_fm_types,                     ONLY: &
      39              :         cp_fm_create, cp_fm_get_info, cp_fm_get_submatrix, cp_fm_init_random, cp_fm_release, &
      40              :         cp_fm_set_all, cp_fm_set_submatrix, cp_fm_to_fm, cp_fm_type
      41              :    USE input_constants,                 ONLY: &
      42              :         do_loc_cpo_atomic, do_loc_cpo_random, do_loc_cpo_restart, do_loc_cpo_space_nmo, &
      43              :         do_loc_cpo_space_wan, op_loc_berry, op_loc_boys, op_loc_pipek, state_loc_list
      44              :    USE input_section_types,             ONLY: section_get_lval,&
      45              :                                               section_vals_get_subs_vals,&
      46              :                                               section_vals_type,&
      47              :                                               section_vals_val_get
      48              :    USE kinds,                           ONLY: default_string_length,&
      49              :                                               dp
      50              :    USE memory_utilities,                ONLY: reallocate
      51              :    USE message_passing,                 ONLY: mp_para_env_type
      52              :    USE particle_types,                  ONLY: particle_type
      53              :    USE qs_atomic_block,                 ONLY: calculate_atomic_block_dm
      54              :    USE qs_environment_types,            ONLY: get_qs_env,&
      55              :                                               qs_environment_type
      56              :    USE qs_kind_types,                   ONLY: qs_kind_type
      57              :    USE qs_loc_methods,                  ONLY: optimize_loc_berry,&
      58              :                                               optimize_loc_pipek,&
      59              :                                               qs_print_cubes
      60              :    USE qs_loc_types,                    ONLY: get_qs_loc_env,&
      61              :                                               localized_wfn_control_type,&
      62              :                                               qs_loc_env_type
      63              :    USE qs_mo_methods,                   ONLY: make_basis_simple,&
      64              :                                               make_basis_sm
      65              :    USE qs_mo_types,                     ONLY: get_mo_set,&
      66              :                                               mo_set_type
      67              :    USE qs_neighbor_list_types,          ONLY: neighbor_list_set_p_type
      68              : #include "./base/base_uses.f90"
      69              : 
      70              :    IMPLICIT NONE
      71              : 
      72              :    PRIVATE
      73              : 
      74              : ! *** Global parameters ***
      75              : 
      76              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_loc_main'
      77              : 
      78              : ! *** Public ***
      79              :    PUBLIC :: qs_loc_driver
      80              : 
      81              : CONTAINS
      82              : 
      83              : ! **************************************************************************************************
      84              : !> \brief set up the calculation of localized orbitals
      85              : !> \param qs_env ...
      86              : !> \param qs_loc_env ...
      87              : !> \param print_loc_section ...
      88              : !> \param myspin ...
      89              : !> \param ext_mo_coeff ...
      90              : !> \par History
      91              : !>      04.2005 created [MI]
      92              : !>      04.2023 refactored [JGH]
      93              : !> \author MI
      94              : ! **************************************************************************************************
      95          916 :    SUBROUTINE qs_loc_driver(qs_env, qs_loc_env, print_loc_section, myspin, ext_mo_coeff)
      96              : 
      97              :       TYPE(qs_environment_type), POINTER                 :: qs_env
      98              :       TYPE(qs_loc_env_type), POINTER                     :: qs_loc_env
      99              :       TYPE(section_vals_type), POINTER                   :: print_loc_section
     100              :       INTEGER, INTENT(IN)                                :: myspin
     101              :       TYPE(cp_fm_type), INTENT(IN), OPTIONAL, TARGET     :: ext_mo_coeff
     102              : 
     103              :       CHARACTER(len=*), PARAMETER                        :: routineN = 'qs_loc_driver'
     104              : 
     105              :       INTEGER                                            :: dim_op, handle, i, imo, imoloc, j, lb, &
     106              :                                                             loc_method, nao, nmosub, restricted, ub
     107          458 :       INTEGER, DIMENSION(:), POINTER                     :: ivec
     108              :       LOGICAL, SAVE                                      :: first_time = .TRUE.
     109              :       REAL(dp), DIMENSION(6)                             :: weights
     110          458 :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: vecbuffer
     111              :       TYPE(cell_type), POINTER                           :: cell
     112              :       TYPE(cp_fm_struct_type), POINTER                   :: tmp_fm_struct
     113          458 :       TYPE(cp_fm_type), DIMENSION(:), POINTER            :: moloc_coeff
     114          458 :       TYPE(cp_fm_type), DIMENSION(:, :), POINTER         :: op_fm_set
     115              :       TYPE(cp_fm_type), POINTER                          :: locorb
     116          458 :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: op_sm_set
     117              :       TYPE(dft_control_type), POINTER                    :: dft_control
     118              :       TYPE(localized_wfn_control_type), POINTER          :: localized_wfn_control
     119          458 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos
     120              :       TYPE(mp_para_env_type), POINTER                    :: para_env
     121              :       TYPE(section_vals_type), POINTER                   :: input, low_spin_roks_section
     122              : 
     123          458 :       CALL timeset(routineN, handle)
     124          458 :       NULLIFY (para_env, mos, dft_control)
     125          458 :       NULLIFY (cell, localized_wfn_control, moloc_coeff, op_sm_set, op_fm_set)
     126          458 :       qs_loc_env%first_time = first_time
     127          458 :       qs_loc_env%target_time = qs_env%target_time
     128          458 :       qs_loc_env%start_time = qs_env%start_time
     129              : 
     130              :       CALL get_qs_loc_env(qs_loc_env=qs_loc_env, &
     131              :                           localized_wfn_control=localized_wfn_control, &
     132              :                           moloc_coeff=moloc_coeff, op_sm_set=op_sm_set, op_fm_set=op_fm_set, cell=cell, &
     133          458 :                           weights=weights, dim_op=dim_op)
     134              : 
     135              :       CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, &
     136          458 :                       para_env=para_env, mos=mos, input=input)
     137              : 
     138              :       !calculation of single occupied states to which unitary transformations should not be applied in LOW SPIN ROKS
     139          458 :       IF (dft_control%restricted) THEN
     140            0 :          low_spin_roks_section => section_vals_get_subs_vals(input, "DFT%LOW_SPIN_ROKS")
     141            0 :          CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", i_rep_val=1, i_vals=ivec)
     142            0 :          restricted = SIZE(ivec)
     143              :       ELSE
     144          458 :          restricted = 0
     145              :       END IF
     146              : 
     147          458 :       NULLIFY (locorb)
     148          458 :       IF (PRESENT(ext_mo_coeff)) THEN
     149          380 :          locorb => ext_mo_coeff
     150              :       ELSE
     151           78 :          CALL get_mo_set(mo_set=mos(myspin), mo_coeff=locorb)
     152              :       END IF
     153              : 
     154          458 :       loc_method = localized_wfn_control%localization_method
     155              : 
     156          458 :       nmosub = localized_wfn_control%nloc_states(myspin)
     157          458 :       IF (localized_wfn_control%operator_type == op_loc_berry) THEN
     158              :          ! Here we allocate op_fm_set with the RIGHT size for uks
     159          458 :          NULLIFY (tmp_fm_struct)
     160              :          CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nmosub, &
     161              :                                   ncol_global=nmosub, para_env=para_env, &
     162          458 :                                   context=locorb%matrix_struct%context)
     163              :          !
     164         5604 :          ALLOCATE (op_fm_set(2, dim_op))
     165         1868 :          DO i = 1, dim_op
     166         4688 :             DO j = 1, SIZE(op_fm_set, 1)
     167         2820 :                CALL cp_fm_create(op_fm_set(j, i), tmp_fm_struct)
     168         2820 :                CALL cp_fm_get_info(op_fm_set(j, i), nrow_global=nmosub)
     169         4230 :                CALL cp_fm_set_all(op_fm_set(j, i), 0.0_dp)
     170              :             END DO
     171              :          END DO
     172          458 :          CALL cp_fm_struct_release(tmp_fm_struct)
     173              :       END IF
     174              : 
     175          458 :       IF (localized_wfn_control%do_mixed) THEN
     176            2 :          CALL loc_mixed_method(qs_env, qs_loc_env, print_loc_section, myspin, op_fm_set)
     177              :       ELSE
     178          912 :          SELECT CASE (localized_wfn_control%operator_type)
     179              :          CASE (op_loc_berry)
     180              :             CALL optimize_loc_berry(loc_method, qs_loc_env, moloc_coeff(myspin), op_sm_set, &
     181              :                                     op_fm_set, para_env, cell, weights, myspin, print_loc_section, &
     182          456 :                                     restricted=restricted)
     183              :          CASE (op_loc_boys)
     184            0 :             CPABORT("Boys localization not implemented")
     185              :          CASE (op_loc_pipek)
     186              :             CALL optimize_loc_pipek(qs_env, loc_method, qs_loc_env, moloc_coeff(myspin), &
     187          456 :                                     op_fm_set, myspin, print_loc_section)
     188              :          END SELECT
     189              :       END IF
     190              : 
     191              :       ! Here we dealloctate op_fm_set
     192          458 :       IF (localized_wfn_control%operator_type == op_loc_berry) THEN
     193          458 :          IF (ASSOCIATED(op_fm_set)) THEN
     194         1868 :             DO i = 1, dim_op
     195         4688 :                DO j = 1, SIZE(op_fm_set, 1)
     196         4230 :                   CALL cp_fm_release(op_fm_set(j, i))
     197              :                END DO
     198              :             END DO
     199          458 :             DEALLOCATE (op_fm_set)
     200              :          END IF
     201              :       END IF
     202              : 
     203              :       ! give back the localized orbitals
     204          458 :       CALL get_mo_set(mo_set=mos(myspin), nao=nao)
     205          458 :       lb = localized_wfn_control%lu_bound_states(1, myspin)
     206          458 :       ub = localized_wfn_control%lu_bound_states(2, myspin)
     207              : 
     208          458 :       IF (localized_wfn_control%set_of_states == state_loc_list) THEN
     209          102 :          ALLOCATE (vecbuffer(1, nao))
     210           34 :          nmosub = SIZE(localized_wfn_control%loc_states, 1)
     211           34 :          imoloc = 0
     212          208 :          DO i = lb, ub
     213              :             ! Get the index in the subset
     214          174 :             imoloc = imoloc + 1
     215              :             ! Get the index in the full set
     216          174 :             imo = localized_wfn_control%loc_states(i, myspin)
     217              : 
     218              :             CALL cp_fm_get_submatrix(moloc_coeff(myspin), vecbuffer, 1, imoloc, &
     219          174 :                                      nao, 1, transpose=.TRUE.)
     220          208 :             CALL cp_fm_set_submatrix(locorb, vecbuffer, 1, imo, nao, 1, transpose=.TRUE.)
     221              :          END DO
     222           34 :          DEALLOCATE (vecbuffer)
     223              :       ELSE
     224          424 :          nmosub = localized_wfn_control%nloc_states(myspin)
     225          424 :          CALL cp_fm_to_fm(moloc_coeff(myspin), locorb, nmosub, 1, lb)
     226              :       END IF
     227              : 
     228              :       ! Write cube files if required
     229          458 :       IF (localized_wfn_control%print_cubes) THEN
     230            6 :          CALL loc_print(qs_env, qs_loc_env, moloc_coeff, myspin, print_loc_section)
     231              :       END IF
     232          458 :       first_time = .FALSE.
     233              : 
     234          458 :       CALL timestop(handle)
     235              : 
     236          458 :    END SUBROUTINE qs_loc_driver
     237              : 
     238              : ! **************************************************************************************************
     239              : !> \brief set up the calculation of localized orbitals
     240              : !> \param qs_env ...
     241              : !> \param qs_loc_env ...
     242              : !> \param print_loc_section ...
     243              : !> \param myspin ...
     244              : !> \param op_fm_set ...
     245              : !> \par History
     246              : !>      04.2023 refactored [JGH]
     247              : !> \author MI
     248              : ! **************************************************************************************************
     249            4 :    SUBROUTINE loc_mixed_method(qs_env, qs_loc_env, print_loc_section, myspin, op_fm_set)
     250              : 
     251              :       TYPE(qs_environment_type), POINTER                 :: qs_env
     252              :       TYPE(qs_loc_env_type), POINTER                     :: qs_loc_env
     253              :       TYPE(section_vals_type), POINTER                   :: print_loc_section
     254              :       INTEGER, INTENT(IN)                                :: myspin
     255              :       TYPE(cp_fm_type), DIMENSION(:, :), POINTER         :: op_fm_set
     256              : 
     257              :       CHARACTER(len=*), PARAMETER                        :: routineN = 'loc_mixed_method'
     258              : 
     259              :       INTEGER                                            :: dim_op, handle, jspin, loc_method, nao, &
     260              :                                                             ndummy, nextra, ngextra, nguess, nmo, &
     261              :                                                             nmosub, norextra, restricted
     262              :       INTEGER, DIMENSION(2)                              :: nelectron_spin
     263            2 :       INTEGER, DIMENSION(:), POINTER                     :: ivec
     264              :       LOGICAL                                            :: do_ortho, has_unit_metric, &
     265              :                                                             my_guess_atomic, my_guess_wan
     266              :       REAL(dp), DIMENSION(6)                             :: weights
     267            2 :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: tmp_mat
     268            2 :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
     269              :       TYPE(cell_type), POINTER                           :: cell
     270              :       TYPE(cp_fm_struct_type), POINTER                   :: tmp_fm_struct
     271              :       TYPE(cp_fm_type)                                   :: mos_guess, tmp_fm, tmp_fm_1, vectors_2
     272            2 :       TYPE(cp_fm_type), DIMENSION(:), POINTER            :: moloc_coeff
     273              :       TYPE(cp_fm_type), POINTER                          :: mo_coeff
     274            2 :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: p_rmpv
     275            2 :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: matrix_s_kp, op_sm_set
     276              :       TYPE(dbcsr_type), POINTER                          :: refmatrix, tmatrix
     277              :       TYPE(dft_control_type), POINTER                    :: dft_control
     278              :       TYPE(localized_wfn_control_type), POINTER          :: localized_wfn_control
     279            2 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos
     280              :       TYPE(mp_para_env_type), POINTER                    :: para_env
     281              :       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
     282            2 :          POINTER                                         :: sab_orb
     283            2 :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
     284            2 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
     285              :       TYPE(section_vals_type), POINTER                   :: input, low_spin_roks_section
     286              : 
     287            2 :       CALL timeset(routineN, handle)
     288              : 
     289            2 :       NULLIFY (moloc_coeff, op_sm_set)
     290            2 :       CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, para_env=para_env, mos=mos, input=input)
     291              : 
     292              :       !calculation of single occupied states to which unitary transformations should not be applied in LOW SPIN ROKS
     293            2 :       IF (dft_control%restricted) THEN
     294            0 :          low_spin_roks_section => section_vals_get_subs_vals(input, "DFT%LOW_SPIN_ROKS")
     295            0 :          CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", i_rep_val=1, i_vals=ivec)
     296            0 :          restricted = SIZE(ivec)
     297              :       ELSE
     298            2 :          restricted = 0
     299              :       END IF
     300              : 
     301              :       CALL get_qs_loc_env(qs_loc_env=qs_loc_env, &
     302              :                           localized_wfn_control=localized_wfn_control, &
     303              :                           moloc_coeff=moloc_coeff, op_sm_set=op_sm_set, cell=cell, &
     304            2 :                           weights=weights, dim_op=dim_op)
     305              : 
     306            2 :       CALL get_mo_set(mo_set=mos(myspin), nao=nao, nmo=nmo)
     307            2 :       loc_method = localized_wfn_control%localization_method
     308            2 :       nmosub = localized_wfn_control%nloc_states(myspin)
     309              : 
     310            2 :       CPASSERT(localized_wfn_control%operator_type == op_loc_berry)
     311            2 :       CPASSERT(localized_wfn_control%do_mixed)
     312              : 
     313            2 :       my_guess_atomic = .FALSE.
     314              :       ! SGh-wan: if atomic guess and do_mixed and nextra > 0
     315              :       ! read CPO_GUESS; CASE ATOMIC / RESTART / RANDOM (0/1/2)
     316              :       ! read CPO_GUESS_SPACE if CASE ATOMIC; CASE ALL / WAN
     317            2 :       nextra = localized_wfn_control%nextra
     318            2 :       IF (nextra > 0) THEN
     319            2 :          my_guess_atomic = .TRUE.
     320            2 :          my_guess_wan = .FALSE.
     321            2 :          do_ortho = .TRUE.
     322            4 :          SELECT CASE (localized_wfn_control%coeff_po_guess)
     323              : 
     324              :          CASE (do_loc_cpo_atomic)
     325            2 :             my_guess_atomic = .TRUE.
     326            2 :             NULLIFY (atomic_kind_set, qs_kind_set, particle_set, matrix_s_kp, sab_orb, p_rmpv, &
     327            2 :                      refmatrix, tmatrix)
     328              :             CALL get_qs_env(qs_env=qs_env, &
     329              :                             atomic_kind_set=atomic_kind_set, &
     330              :                             qs_kind_set=qs_kind_set, &
     331              :                             particle_set=particle_set, &
     332              :                             matrix_s_kp=matrix_s_kp, &
     333              :                             has_unit_metric=has_unit_metric, &
     334              :                             nelectron_spin=nelectron_spin, &
     335            2 :                             sab_orb=sab_orb)
     336              : 
     337            2 :             refmatrix => matrix_s_kp(1, 1)%matrix
     338              :             ! create p_rmpv
     339            2 :             CALL dbcsr_allocate_matrix_set(p_rmpv, dft_control%nspins)
     340            4 :             DO jspin = 1, dft_control%nspins
     341            2 :                ALLOCATE (p_rmpv(jspin)%matrix)
     342            2 :                tmatrix => p_rmpv(jspin)%matrix
     343              :                CALL dbcsr_create(matrix=tmatrix, template=refmatrix, &
     344            2 :                                  matrix_type=dbcsr_type_symmetric)
     345            2 :                CALL cp_dbcsr_alloc_block_from_nbl(tmatrix, sab_orb)
     346            4 :                CALL dbcsr_set(tmatrix, 0.0_dp)
     347              :             END DO
     348              :             CALL calculate_atomic_block_dm(p_rmpv, refmatrix, atomic_kind_set, qs_kind_set, &
     349            2 :                                            dft_control%nspins, nelectron_spin, 0, para_env)
     350              :          CASE (do_loc_cpo_restart)
     351            0 :             my_guess_atomic = .FALSE.
     352            0 :             my_guess_wan = .TRUE.
     353              :          CASE (do_loc_cpo_random)
     354            2 :             my_guess_atomic = .FALSE.
     355              :          END SELECT
     356              : 
     357            2 :          norextra = nmo - nmosub
     358            2 :          CALL get_mo_set(mo_set=mos(myspin), mo_coeff=mo_coeff)
     359              :          CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nao, &
     360            2 :                                   ncol_global=norextra, para_env=para_env, context=mo_coeff%matrix_struct%context)
     361            2 :          CALL cp_fm_create(vectors_2, tmp_fm_struct)
     362            2 :          CALL cp_fm_struct_release(tmp_fm_struct)
     363            8 :          ALLOCATE (tmp_mat(nao, norextra))
     364            2 :          CALL cp_fm_get_submatrix(mo_coeff, tmp_mat, 1, nmosub + 1)
     365            2 :          CALL cp_fm_set_submatrix(vectors_2, tmp_mat)
     366            2 :          DEALLOCATE (tmp_mat)
     367              : 
     368              :          ! if guess "atomic" generate MOs based on atomic densities and
     369              :          ! pass on to optimize_loc_berry
     370            2 :          IF (my_guess_atomic .OR. my_guess_wan) THEN
     371              : 
     372            4 :             SELECT CASE (localized_wfn_control%coeff_po_guess_mo_space)
     373              : 
     374              :             CASE (do_loc_cpo_space_wan)
     375            2 :                ndummy = nmosub
     376              :             CASE (do_loc_cpo_space_nmo)
     377            0 :                ndummy = nmo
     378            2 :                do_ortho = .FALSE.
     379              : 
     380              :             END SELECT
     381              : 
     382              :             CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nao, &
     383              :                                      ncol_global=ndummy, para_env=para_env, &
     384            2 :                                      context=mo_coeff%matrix_struct%context)
     385            2 :             CALL cp_fm_create(mos_guess, tmp_fm_struct)
     386            2 :             CALL cp_fm_set_all(mos_guess, 0.0_dp)
     387              : 
     388            2 :             IF (my_guess_atomic) THEN
     389            2 :                CALL cp_fm_create(tmp_fm, tmp_fm_struct)
     390            2 :                CALL cp_fm_create(tmp_fm_1, tmp_fm_struct)
     391            2 :                CALL cp_fm_set_all(tmp_fm, 0.0_dp)
     392            2 :                CALL cp_fm_set_all(tmp_fm_1, 0.0_dp)
     393            2 :                CALL cp_fm_init_random(tmp_fm, ndummy)
     394            2 :                IF (has_unit_metric) THEN
     395            0 :                   CALL cp_fm_to_fm(tmp_fm, tmp_fm_1)
     396              :                ELSE
     397              :                   ! PS*C(:,1:nomo)+C(:,nomo+1:nmo) (nomo=NINT(nelectron/maxocc))
     398            2 :                   CALL cp_dbcsr_sm_fm_multiply(refmatrix, tmp_fm, tmp_fm_1, ndummy)
     399              :                END IF
     400            2 :                CALL cp_dbcsr_sm_fm_multiply(p_rmpv(myspin)%matrix, tmp_fm_1, mos_guess, ndummy)
     401            2 :                CALL cp_fm_release(tmp_fm)
     402            2 :                CALL cp_fm_release(tmp_fm_1)
     403            2 :                CALL cp_fm_struct_release(tmp_fm_struct)
     404            0 :             ELSEIF (my_guess_wan) THEN
     405            0 :                nguess = localized_wfn_control%nguess(myspin)
     406            0 :                ALLOCATE (tmp_mat(nao, nguess))
     407            0 :                CALL cp_fm_get_submatrix(moloc_coeff(myspin), tmp_mat, 1, 1, nao, nguess)
     408            0 :                CALL cp_fm_set_submatrix(mos_guess, tmp_mat, 1, 1, nao, nguess)
     409            0 :                DEALLOCATE (tmp_mat)
     410            0 :                ngextra = nmosub - nguess
     411              :                !WRITE(*,*) 'nguess, ngextra = ', nguess, ngextra
     412            0 :                CALL cp_fm_struct_release(tmp_fm_struct)
     413            0 :                IF (ngextra > 0) THEN
     414              :                   CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nao, &
     415              :                                            ncol_global=ngextra, para_env=para_env, &
     416            0 :                                            context=mo_coeff%matrix_struct%context)
     417            0 :                   CALL cp_fm_create(tmp_fm, tmp_fm_struct)
     418            0 :                   CALL cp_fm_init_random(tmp_fm, ngextra)
     419            0 :                   ALLOCATE (tmp_mat(nao, ngextra))
     420            0 :                   CALL cp_fm_get_submatrix(tmp_fm, tmp_mat, 1, 1, nao, ngextra)
     421            0 :                   CALL cp_fm_set_submatrix(mos_guess, tmp_mat, 1, nguess + 1, nao, ngextra)
     422            0 :                   DEALLOCATE (tmp_mat)
     423            0 :                   CALL cp_fm_release(tmp_fm)
     424            0 :                   CALL cp_fm_struct_release(tmp_fm_struct)
     425              :                ELSE
     426              :                   do_ortho = .FALSE.
     427              :                END IF
     428            0 :                ALLOCATE (tmp_mat(nao, nmosub))
     429            0 :                CALL cp_fm_get_submatrix(mo_coeff, tmp_mat, 1, 1, nao, nmosub)
     430            0 :                CALL cp_fm_set_submatrix(moloc_coeff(myspin), tmp_mat)
     431            0 :                DEALLOCATE (tmp_mat)
     432              :             END IF
     433              : 
     434            2 :             IF (do_ortho) THEN
     435              :                IF ((my_guess_atomic) .OR. (my_guess_wan)) THEN
     436              :                         !! and ortho the result
     437            2 :                   IF (has_unit_metric) THEN
     438            0 :                      CALL make_basis_simple(mos_guess, ndummy)
     439              :                   ELSE
     440            2 :                      CALL make_basis_sm(mos_guess, ndummy, refmatrix)
     441              :                   END IF
     442              :                END IF
     443              :             END IF
     444              : 
     445              :             CALL optimize_loc_berry(loc_method, qs_loc_env, moloc_coeff(myspin), op_sm_set, &
     446              :                                     op_fm_set, para_env, cell, weights, myspin, print_loc_section, &
     447              :                                     restricted=restricted, &
     448            2 :                                     nextra=nextra, nmo=nmo, vectors_2=vectors_2, guess_mos=mos_guess)
     449            2 :             CALL cp_fm_release(mos_guess)
     450              :          ELSE
     451              :             CALL optimize_loc_berry(loc_method, qs_loc_env, moloc_coeff(myspin), op_sm_set, &
     452              :                                     op_fm_set, para_env, cell, weights, myspin, print_loc_section, &
     453              :                                     restricted=restricted, &
     454            0 :                                     nextra=nextra, nmo=nmo, vectors_2=vectors_2)
     455              :          END IF
     456            2 :          CALL cp_fm_release(vectors_2)
     457            4 :          IF (my_guess_atomic) CALL dbcsr_deallocate_matrix_set(p_rmpv)
     458              :       ELSE
     459              :          CALL optimize_loc_berry(loc_method, qs_loc_env, moloc_coeff(myspin), op_sm_set, &
     460              :                                  op_fm_set, para_env, cell, weights, myspin, print_loc_section, &
     461            0 :                                  restricted=restricted, nextra=0)
     462              :       END IF
     463              : 
     464            2 :       CALL timestop(handle)
     465              : 
     466            2 :    END SUBROUTINE loc_mixed_method
     467              : 
     468              : ! **************************************************************************************************
     469              : !> \brief printing of Cube files of localized orbitals
     470              : !> \param qs_env ...
     471              : !> \param qs_loc_env ...
     472              : !> \param moloc_coeff ...
     473              : !> \param ispin ...
     474              : !> \param print_loc_section ...
     475              : ! **************************************************************************************************
     476            6 :    SUBROUTINE loc_print(qs_env, qs_loc_env, moloc_coeff, ispin, print_loc_section)
     477              : 
     478              :       TYPE(qs_environment_type), POINTER                 :: qs_env
     479              :       TYPE(qs_loc_env_type), POINTER                     :: qs_loc_env
     480              :       TYPE(cp_fm_type), DIMENSION(:), POINTER            :: moloc_coeff
     481              :       INTEGER, INTENT(IN), OPTIONAL                      :: ispin
     482              :       TYPE(section_vals_type), POINTER                   :: print_loc_section
     483              : 
     484              :       CHARACTER(LEN=default_string_length)               :: my_pos
     485              :       INTEGER                                            :: i, ir, istate, j, jstate, n_rep, ncubes, &
     486              :                                                             nmo
     487            6 :       INTEGER, DIMENSION(:), POINTER                     :: bounds, list, list_cubes
     488              :       LOGICAL                                            :: append_cube, list_cubes_setup
     489            6 :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: centers
     490              :       TYPE(localized_wfn_control_type), POINTER          :: localized_wfn_control
     491              :       TYPE(section_vals_type), POINTER                   :: print_key
     492              : 
     493            6 :       list_cubes_setup = .FALSE.
     494            6 :       NULLIFY (bounds, list, list_cubes)
     495              : 
     496              :       CALL get_qs_loc_env(qs_loc_env=qs_loc_env, &
     497            6 :                           localized_wfn_control=localized_wfn_control)
     498              : 
     499              :       ! Provides boundaries of MOs
     500              :       CALL section_vals_val_get(print_loc_section, "WANNIER_CUBES%CUBES_LU_BOUNDS", &
     501            6 :                                 i_vals=bounds)
     502            6 :       ncubes = bounds(2) - bounds(1) + 1
     503            6 :       IF (ncubes > 0) THEN
     504            0 :          list_cubes_setup = .TRUE.
     505            0 :          ALLOCATE (list_cubes(ncubes))
     506            0 :          DO ir = 1, ncubes
     507            0 :             list_cubes(ir) = bounds(1) + (ir - 1)
     508              :          END DO
     509              :       END IF
     510              : 
     511              :       ! Provides the list of MOs
     512              :       CALL section_vals_val_get(print_loc_section, "WANNIER_CUBES%CUBES_LIST", &
     513            6 :                                 n_rep_val=n_rep)
     514            6 :       IF (.NOT. list_cubes_setup) THEN
     515            6 :          ncubes = 0
     516            6 :          DO ir = 1, n_rep
     517              :             CALL section_vals_val_get(print_loc_section, "WANNIER_CUBES%CUBES_LIST", &
     518            0 :                                       i_rep_val=ir, i_vals=list)
     519            6 :             IF (ASSOCIATED(list)) THEN
     520            0 :                CALL reallocate(list_cubes, 1, ncubes + SIZE(list))
     521            0 :                DO i = 1, SIZE(list)
     522            0 :                   list_cubes(i + ncubes) = list(i)
     523              :                END DO
     524            0 :                ncubes = ncubes + SIZE(list)
     525              :             END IF
     526              :          END DO
     527            6 :          IF (ncubes > 0) list_cubes_setup = .TRUE.
     528              :       END IF
     529              : 
     530              :       ! Full list of Mos
     531              :       IF (.NOT. list_cubes_setup) THEN
     532            6 :          list_cubes_setup = .TRUE.
     533            6 :          ncubes = localized_wfn_control%nloc_states(1)
     534            6 :          IF (ncubes > 0) THEN
     535           18 :             ALLOCATE (list_cubes(ncubes))
     536              :          END IF
     537           42 :          DO i = 1, ncubes
     538           42 :             list_cubes(i) = i
     539              :          END DO
     540              :       END IF
     541              : 
     542            6 :       ncubes = SIZE(list_cubes)
     543            6 :       CALL cp_fm_get_info(moloc_coeff(ispin), ncol_global=nmo)
     544            6 :       ncubes = MIN(ncubes, nmo)
     545           18 :       ALLOCATE (centers(6, ncubes))
     546           42 :       DO i = 1, ncubes
     547           36 :          istate = list_cubes(i)
     548          156 :          DO j = 1, localized_wfn_control%nloc_states(ispin)
     549          150 :             jstate = localized_wfn_control%loc_states(j, ispin)
     550          150 :             IF (istate == jstate) THEN
     551          252 :                centers(1:6, i) = localized_wfn_control%centers_set(ispin)%array(1:6, j)
     552              :                EXIT
     553              :             END IF
     554              :          END DO
     555              :       END DO ! ncubes
     556              : 
     557              :       ! Real call for dumping the cube files
     558            6 :       print_key => section_vals_get_subs_vals(print_loc_section, "WANNIER_CUBES")
     559            6 :       append_cube = section_get_lval(print_loc_section, "WANNIER_CUBES%APPEND")
     560            6 :       my_pos = "REWIND"
     561            6 :       IF (append_cube) THEN
     562            0 :          my_pos = "APPEND"
     563              :       END IF
     564              : 
     565              :       CALL qs_print_cubes(qs_env, moloc_coeff(ispin), ncubes, list_cubes, centers, &
     566              :                           print_key, "loc"//TRIM(ADJUSTL(qs_loc_env%tag_mo)), &
     567            6 :                           ispin=ispin, file_position=my_pos)
     568              : 
     569            6 :       DEALLOCATE (centers)
     570            6 :       DEALLOCATE (list_cubes)
     571              : 
     572           18 :    END SUBROUTINE loc_print
     573              : 
     574              : END MODULE qs_loc_main
        

Generated by: LCOV version 2.0-1