1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief Definition and initialisation of the mo data type. 8!> \par History 9!> - adapted to the new QS environment data structure (02.04.2002,MK) 10!> - set_mo_occupation added (17.04.02,MK) 11!> - correct_mo_eigenvalues added (18.04.02,MK) 12!> - calculate_density_matrix moved from qs_scf to here (22.04.02,MK) 13!> - mo_set_p_type added (23.04.02,MK) 14!> - PRIVATE attribute set for TYPE mo_set_type (23.04.02,MK) 15!> - started conversion to LSD (1.2003, Joost VandeVondele) 16!> - set_mo_occupation moved to qs_mo_occupation (11.12.14 MI) 17!> - correct_mo_eigenvalues moved to qs_scf_methods (03.2016, Sergey Chulkov) 18!> \author Matthias Krack (09.05.2001,MK) 19! ************************************************************************************************** 20MODULE qs_mo_types 21 22 USE cp_dbcsr_operations, ONLY: dbcsr_copy_columns_hack 23 USE cp_fm_pool_types, ONLY: cp_fm_pool_type,& 24 fm_pool_create_fm 25 USE cp_fm_types, ONLY: cp_fm_create,& 26 cp_fm_get_info,& 27 cp_fm_release,& 28 cp_fm_to_fm,& 29 cp_fm_type 30 USE dbcsr_api, ONLY: dbcsr_copy,& 31 dbcsr_init_p,& 32 dbcsr_release_p,& 33 dbcsr_type 34 USE kinds, ONLY: dp 35#include "./base/base_uses.f90" 36 37 IMPLICIT NONE 38 39 PRIVATE 40 41 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_mo_types' 42 43 TYPE mo_set_type 44 ! the actual MO coefficients as a matrix 45 TYPE(cp_fm_type), POINTER :: mo_coeff 46 TYPE(dbcsr_type), POINTER :: mo_coeff_b 47 ! we are using the dbcsr mo_coeff_b 48 LOGICAL :: use_mo_coeff_b 49 ! number of molecular orbitals (# cols in mo_coeff) 50 INTEGER :: nmo 51 ! number of atomic orbitals (# rows in mo_coeff) 52 INTEGER :: nao 53 ! occupation - eigenvalues of the nmo states (if eigenstates) 54 REAL(KIND=dp), DIMENSION(:), POINTER :: eigenvalues, occupation_numbers 55 ! maximum allowed occupation number of an MO (1 or 2) 56 REAL(KIND=dp) :: maxocc 57 ! number of electrons (taking occupation into account) 58 INTEGER :: nelectron 59 REAL(KIND=dp) :: n_el_f 60 ! highest non-zero occupied orbital 61 INTEGER :: homo 62 ! lowest non maxocc occupied orbital (e.g. fractional or zero) 63 INTEGER :: lfomo 64 ! flag that indicates if the MOS have the same occupation number 65 LOGICAL :: uniform_occupation 66 ! the entropic energy contribution 67 REAL(KIND=dp) :: kTS 68 ! Fermi energy level 69 REAL(KIND=dp) :: mu 70 ! Threshold value for multiplicity change 71 REAL(KIND=dp) :: flexible_electron_count 72 END TYPE mo_set_type 73 74 TYPE mo_set_p_type 75 TYPE(mo_set_type), POINTER :: mo_set 76 END TYPE mo_set_p_type 77 78 PUBLIC :: mo_set_p_type, & 79 mo_set_type 80 81 PUBLIC :: allocate_mo_set, & 82 deallocate_mo_set, & 83 get_mo_set, & 84 init_mo_set, & 85 set_mo_set, & 86 mo_set_restrict, & 87 duplicate_mo_set 88 89CONTAINS 90 91! ************************************************************************************************** 92!> \brief allocate a new mo_set, and copy the old data 93!> \param mo_set_new ... 94!> \param mo_set_old ... 95!> \date 2009-7-19 96!> \par History 97!> \author Joost VandeVondele 98! ************************************************************************************************** 99 SUBROUTINE duplicate_mo_set(mo_set_new, mo_set_old) 100 TYPE(mo_set_type), POINTER :: mo_set_new, mo_set_old 101 102 CHARACTER(LEN=*), PARAMETER :: routineN = 'duplicate_mo_set', & 103 routineP = moduleN//':'//routineN 104 105 INTEGER :: nmo 106 107 ALLOCATE (mo_set_new) 108 109 mo_set_new%maxocc = mo_set_old%maxocc 110 mo_set_new%nelectron = mo_set_old%nelectron 111 mo_set_new%n_el_f = mo_set_old%n_el_f 112 mo_set_new%nao = mo_set_old%nao 113 mo_set_new%nmo = mo_set_old%nmo 114 mo_set_new%homo = mo_set_old%homo 115 mo_set_new%lfomo = mo_set_old%lfomo 116 mo_set_new%uniform_occupation = mo_set_old%uniform_occupation 117 mo_set_new%kTS = mo_set_old%kTS 118 mo_set_new%mu = mo_set_old%mu 119 mo_set_new%flexible_electron_count = mo_set_old%flexible_electron_count 120 121 nmo = mo_set_new%nmo 122 123 NULLIFY (mo_set_new%mo_coeff) 124 CALL cp_fm_create(mo_set_new%mo_coeff, mo_set_old%mo_coeff%matrix_struct) 125 CALL cp_fm_to_fm(mo_set_old%mo_coeff, mo_set_new%mo_coeff) 126 127 NULLIFY (mo_set_new%mo_coeff_b) 128 IF (ASSOCIATED(mo_set_old%mo_coeff_b)) THEN 129 CALL dbcsr_init_p(mo_set_new%mo_coeff_b) 130 CALL dbcsr_copy(mo_set_new%mo_coeff_b, mo_set_old%mo_coeff_b) 131 ENDIF 132 mo_set_new%use_mo_coeff_b = mo_set_old%use_mo_coeff_b 133 134 ALLOCATE (mo_set_new%eigenvalues(nmo)) 135 mo_set_new%eigenvalues = mo_set_old%eigenvalues 136 137 ALLOCATE (mo_set_new%occupation_numbers(nmo)) 138 mo_set_new%occupation_numbers = mo_set_old%occupation_numbers 139 140 END SUBROUTINE duplicate_mo_set 141 142! ************************************************************************************************** 143!> \brief Allocates a mo set and partially initializes it (nao,nmo,nelectron, 144!> and flexible_electron_count are vaild). 145!> For the full initialization you need to call init_mo_set 146!> \param mo_set the mo_set to allocate 147!> \param nao number of atom orbitals 148!> \param nmo number of molecular orbitals 149!> \param nelectron number of electrons 150!> \param n_el_f ... 151!> \param maxocc maximum occupation of an orbital (LDA: 2, LSD:1) 152!> \param flexible_electron_count the number of electrons can be changed 153!> \date 15.05.2001 154!> \par History 155!> 11.2002 splitted initialization in two phases [fawzi] 156!> \author Matthias Krack 157! ************************************************************************************************** 158 SUBROUTINE allocate_mo_set(mo_set, nao, nmo, nelectron, n_el_f, maxocc, & 159 flexible_electron_count) 160 161 TYPE(mo_set_type), POINTER :: mo_set 162 INTEGER, INTENT(IN) :: nao, nmo, nelectron 163 REAL(KIND=dp), INTENT(IN) :: n_el_f, maxocc, flexible_electron_count 164 165 CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_mo_set', & 166 routineP = moduleN//':'//routineN 167 168 IF (ASSOCIATED(mo_set)) CALL deallocate_mo_set(mo_set) 169 170 ALLOCATE (mo_set) 171 172 mo_set%maxocc = maxocc 173 mo_set%nelectron = nelectron 174 mo_set%n_el_f = n_el_f 175 mo_set%nao = nao 176 mo_set%nmo = nmo 177 mo_set%homo = 0 178 mo_set%lfomo = 0 179 mo_set%uniform_occupation = .TRUE. 180 mo_set%kTS = 0.0_dp 181 mo_set%mu = 0.0_dp 182 mo_set%flexible_electron_count = flexible_electron_count 183 184 NULLIFY (mo_set%eigenvalues) 185 NULLIFY (mo_set%occupation_numbers) 186 NULLIFY (mo_set%mo_coeff) 187 NULLIFY (mo_set%mo_coeff_b) 188 mo_set%use_mo_coeff_b = .FALSE. 189 190 END SUBROUTINE allocate_mo_set 191 192! ************************************************************************************************** 193!> \brief initializes an allocated mo_set. 194!> eigenvalues, mo_coeff, occupation_numbers are valid only 195!> after this call. 196!> \param mo_set the mo_set to initialize 197!> \param fm_pool a pool out which you initialize the mo_set 198!> \param fm_ref a reference matrix from which you initialize the mo_set 199!> \param name ... 200!> \par History 201!> 11.2002 rewamped [fawzi] 202!> \author Fawzi Mohamed 203! ************************************************************************************************** 204 SUBROUTINE init_mo_set(mo_set, fm_pool, fm_ref, name) 205 206 TYPE(mo_set_type), POINTER :: mo_set 207 TYPE(cp_fm_pool_type), OPTIONAL, POINTER :: fm_pool 208 TYPE(cp_fm_type), OPTIONAL, POINTER :: fm_ref 209 CHARACTER(LEN=*), INTENT(in) :: name 210 211 CHARACTER(LEN=*), PARAMETER :: routineN = 'init_mo_set', routineP = moduleN//':'//routineN 212 213 INTEGER :: nao, nmo, nomo 214 215 CPASSERT(ASSOCIATED(mo_set)) 216 CPASSERT(.NOT. ASSOCIATED(mo_set%eigenvalues)) 217 CPASSERT(.NOT. ASSOCIATED(mo_set%occupation_numbers)) 218 CPASSERT(.NOT. ASSOCIATED(mo_set%mo_coeff)) 219 220 CPASSERT(PRESENT(fm_pool) .OR. PRESENT(fm_ref)) 221 IF (PRESENT(fm_pool)) THEN 222 CPASSERT(ASSOCIATED(fm_pool)) 223 CALL fm_pool_create_fm(fm_pool, mo_set%mo_coeff, name=name) 224 ELSE IF (PRESENT(fm_ref)) THEN 225 CPASSERT(ASSOCIATED(fm_ref)) 226 CALL cp_fm_create(mo_set%mo_coeff, fm_ref%matrix_struct, name=name) 227 END IF 228 CALL cp_fm_get_info(mo_set%mo_coeff, nrow_global=nao, ncol_global=nmo) 229 230 CPASSERT(nao >= mo_set%nao) 231 CPASSERT(nmo >= mo_set%nmo) 232 233 ALLOCATE (mo_set%eigenvalues(nmo)) 234 mo_set%eigenvalues(:) = 0.0_dp 235 236 ALLOCATE (mo_set%occupation_numbers(nmo)) 237 ! Initialize MO occupations 238 mo_set%occupation_numbers(:) = 0.0_dp 239 ! Quick return, if no electrons are available 240 IF (mo_set%nelectron == 0) THEN 241 RETURN 242 END IF 243 244 IF (MODULO(mo_set%nelectron, INT(mo_set%maxocc)) == 0) THEN 245 nomo = NINT(mo_set%nelectron/mo_set%maxocc) 246 mo_set%occupation_numbers(1:nomo) = mo_set%maxocc 247 ELSE 248 nomo = INT(mo_set%nelectron/mo_set%maxocc) + 1 249 ! Initialize MO occupations 250 mo_set%occupation_numbers(1:nomo - 1) = mo_set%maxocc 251 mo_set%occupation_numbers(nomo) = mo_set%nelectron - (nomo - 1)*mo_set%maxocc 252 END IF 253 254 CPASSERT(nmo >= nomo) 255 CPASSERT((SIZE(mo_set%occupation_numbers) == nmo)) 256 257 mo_set%homo = nomo 258 mo_set%lfomo = nomo + 1 259 mo_set%mu = mo_set%eigenvalues(nomo) 260 261 END SUBROUTINE init_mo_set 262 263! ************************************************************************************************** 264!> \brief make the beta orbitals explicitly equal to the alpha orbitals 265!> effectively copying the orbital data 266!> \param mo_array ... 267!> \param convert_dbcsr ... 268!> \par History 269!> 10.2004 created [Joost VandeVondele] 270! ************************************************************************************************** 271 SUBROUTINE mo_set_restrict(mo_array, convert_dbcsr) 272 TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mo_array 273 LOGICAL, INTENT(in), OPTIONAL :: convert_dbcsr 274 275 CHARACTER(LEN=*), PARAMETER :: routineN = 'mo_set_restrict', & 276 routineP = moduleN//':'//routineN 277 278 INTEGER :: handle 279 LOGICAL :: my_convert_dbcsr 280 281 CALL timeset(routineN, handle) 282 283 my_convert_dbcsr = .FALSE. 284 IF (PRESENT(convert_dbcsr)) my_convert_dbcsr = convert_dbcsr 285 286 CPASSERT(ASSOCIATED(mo_array)) 287 CPASSERT(SIZE(mo_array) .EQ. 2) 288 CPASSERT(mo_array(1)%mo_set%nmo >= mo_array(2)%mo_set%nmo) 289 290 ! first nmo_beta orbitals are copied from alpha to beta 291 IF (my_convert_dbcsr) THEN !fm->dbcsr 292 CALL dbcsr_copy_columns_hack(mo_array(2)%mo_set%mo_coeff_b, mo_array(1)%mo_set%mo_coeff_b, & !fm->dbcsr 293 mo_array(2)%mo_set%nmo, 1, 1, & !fm->dbcsr 294 para_env=mo_array(1)%mo_set%mo_coeff%matrix_struct%para_env, & !fm->dbcsr 295 blacs_env=mo_array(1)%mo_set%mo_coeff%matrix_struct%context) !fm->dbcsr 296 ELSE !fm->dbcsr 297 CALL cp_fm_to_fm(mo_array(1)%mo_set%mo_coeff, mo_array(2)%mo_set%mo_coeff, mo_array(2)%mo_set%nmo) 298 ENDIF 299 300 CALL timestop(handle) 301 302 END SUBROUTINE mo_set_restrict 303 304! ************************************************************************************************** 305!> \brief Deallocate a wavefunction data structure. 306!> \param mo_set ... 307!> \date 15.05.2001 308!> \author MK 309!> \version 1.0 310! ************************************************************************************************** 311 SUBROUTINE deallocate_mo_set(mo_set) 312 313 TYPE(mo_set_type), POINTER :: mo_set 314 315 CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_mo_set', & 316 routineP = moduleN//':'//routineN 317 318 IF (ASSOCIATED(mo_set)) THEN 319 IF (ASSOCIATED(mo_set%eigenvalues)) THEN 320 DEALLOCATE (mo_set%eigenvalues) 321 END IF 322 IF (ASSOCIATED(mo_set%occupation_numbers)) THEN 323 DEALLOCATE (mo_set%occupation_numbers) 324 END IF 325 CALL cp_fm_release(mo_set%mo_coeff) 326 IF (ASSOCIATED(mo_set%mo_coeff_b)) CALL dbcsr_release_p(mo_set%mo_coeff_b) 327 DEALLOCATE (mo_set) 328 END IF 329 330 END SUBROUTINE deallocate_mo_set 331 332! ************************************************************************************************** 333!> \brief Get the components of a MO set data structure. 334!> \param mo_set ... 335!> \param maxocc ... 336!> \param homo ... 337!> \param lfomo ... 338!> \param nao ... 339!> \param nelectron ... 340!> \param n_el_f ... 341!> \param nmo ... 342!> \param eigenvalues ... 343!> \param occupation_numbers ... 344!> \param mo_coeff ... 345!> \param mo_coeff_b ... 346!> \param uniform_occupation ... 347!> \param kTS ... 348!> \param mu ... 349!> \param flexible_electron_count ... 350!> \date 22.04.2002 351!> \author MK 352!> \version 1.0 353! ************************************************************************************************** 354 SUBROUTINE get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, & 355 eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, & 356 uniform_occupation, kTS, mu, flexible_electron_count) 357 358 TYPE(mo_set_type), POINTER :: mo_set 359 REAL(KIND=dp), INTENT(OUT), OPTIONAL :: maxocc 360 INTEGER, INTENT(OUT), OPTIONAL :: homo, lfomo, nao, nelectron 361 REAL(KIND=dp), INTENT(OUT), OPTIONAL :: n_el_f 362 INTEGER, INTENT(OUT), OPTIONAL :: nmo 363 REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: eigenvalues, occupation_numbers 364 TYPE(cp_fm_type), OPTIONAL, POINTER :: mo_coeff 365 TYPE(dbcsr_type), OPTIONAL, POINTER :: mo_coeff_b 366 LOGICAL, INTENT(OUT), OPTIONAL :: uniform_occupation 367 REAL(KIND=dp), INTENT(OUT), OPTIONAL :: kTS, mu, flexible_electron_count 368 369 IF (PRESENT(maxocc)) maxocc = mo_set%maxocc 370 IF (PRESENT(homo)) homo = mo_set%homo 371 IF (PRESENT(lfomo)) lfomo = mo_set%lfomo 372 IF (PRESENT(nao)) nao = mo_set%nao 373 IF (PRESENT(nelectron)) nelectron = mo_set%nelectron 374 IF (PRESENT(n_el_f)) n_el_f = mo_set%n_el_f 375 IF (PRESENT(nmo)) nmo = mo_set%nmo 376 IF (PRESENT(eigenvalues)) eigenvalues => mo_set%eigenvalues 377 IF (PRESENT(occupation_numbers)) THEN 378 occupation_numbers => mo_set%occupation_numbers 379 END IF 380 IF (PRESENT(mo_coeff)) mo_coeff => mo_set%mo_coeff 381 IF (PRESENT(mo_coeff_b)) mo_coeff_b => mo_set%mo_coeff_b 382 IF (PRESENT(uniform_occupation)) uniform_occupation = mo_set%uniform_occupation 383 IF (PRESENT(kTS)) kTS = mo_set%kTS 384 IF (PRESENT(mu)) mu = mo_set%mu 385 IF (PRESENT(flexible_electron_count)) flexible_electron_count = mo_set%flexible_electron_count 386 387 END SUBROUTINE get_mo_set 388 389! ************************************************************************************************** 390!> \brief Set the components of a MO set data structure. 391!> \param mo_set ... 392!> \param maxocc ... 393!> \param homo ... 394!> \param lfomo ... 395!> \param nao ... 396!> \param nelectron ... 397!> \param n_el_f ... 398!> \param nmo ... 399!> \param eigenvalues ... 400!> \param occupation_numbers ... 401!> \param uniform_occupation ... 402!> \param kTS ... 403!> \param mu ... 404!> \param flexible_electron_count ... 405!> \date 22.04.2002 406!> \author MK 407!> \version 1.0 408! ************************************************************************************************** 409 SUBROUTINE set_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, & 410 eigenvalues, occupation_numbers, uniform_occupation, & 411 kTS, mu, flexible_electron_count) 412 413 TYPE(mo_set_type), POINTER :: mo_set 414 REAL(KIND=dp), INTENT(IN), OPTIONAL :: maxocc 415 INTEGER, INTENT(IN), OPTIONAL :: homo, lfomo, nao, nelectron 416 REAL(KIND=dp), INTENT(IN), OPTIONAL :: n_el_f 417 INTEGER, INTENT(IN), OPTIONAL :: nmo 418 REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER :: eigenvalues, occupation_numbers 419 LOGICAL, INTENT(IN), OPTIONAL :: uniform_occupation 420 REAL(KIND=dp), INTENT(IN), OPTIONAL :: kTS, mu, flexible_electron_count 421 422 CHARACTER(LEN=*), PARAMETER :: routineN = 'set_mo_set', routineP = moduleN//':'//routineN 423 424 IF (PRESENT(maxocc)) mo_set%maxocc = maxocc 425 IF (PRESENT(homo)) mo_set%homo = homo 426 IF (PRESENT(lfomo)) mo_set%lfomo = lfomo 427 IF (PRESENT(nao)) mo_set%nao = nao 428 IF (PRESENT(nelectron)) mo_set%nelectron = nelectron 429 IF (PRESENT(n_el_f)) mo_set%n_el_f = n_el_f 430 IF (PRESENT(nmo)) mo_set%nmo = nmo 431 IF (PRESENT(eigenvalues)) THEN 432 IF (ASSOCIATED(mo_set%eigenvalues)) THEN 433 DEALLOCATE (mo_set%eigenvalues) 434 END IF 435 mo_set%eigenvalues => eigenvalues 436 END IF 437 IF (PRESENT(occupation_numbers)) THEN 438 IF (ASSOCIATED(mo_set%occupation_numbers)) THEN 439 DEALLOCATE (mo_set%occupation_numbers) 440 END IF 441 mo_set%occupation_numbers => occupation_numbers 442 END IF 443 IF (PRESENT(uniform_occupation)) mo_set%uniform_occupation = uniform_occupation 444 IF (PRESENT(kTS)) mo_set%kTS = kTS 445 IF (PRESENT(mu)) mo_set%mu = mu 446 IF (PRESENT(flexible_electron_count)) mo_set%flexible_electron_count = flexible_electron_count 447 448 END SUBROUTINE set_mo_set 449 450END MODULE qs_mo_types 451