(git:ccc2433)
qs_mo_types.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief Definition and initialisation of the mo data type.
10 !> \par History
11 !> - adapted to the new QS environment data structure (02.04.2002,MK)
12 !> - set_mo_occupation added (17.04.02,MK)
13 !> - correct_mo_eigenvalues added (18.04.02,MK)
14 !> - calculate_density_matrix moved from qs_scf to here (22.04.02,MK)
15 !> - mo_set_p_type added (23.04.02,MK)
16 !> - PRIVATE attribute set for TYPE mo_set_type (23.04.02,MK)
17 !> - started conversion to LSD (1.2003, Joost VandeVondele)
18 !> - set_mo_occupation moved to qs_mo_occupation (11.12.14 MI)
19 !> - correct_mo_eigenvalues moved to qs_scf_methods (03.2016, Sergey Chulkov)
20 !> \author Matthias Krack (09.05.2001,MK)
21 ! **************************************************************************************************
23 
25  USE cp_fm_pool_types, ONLY: cp_fm_pool_type,&
27  USE cp_fm_struct, ONLY: cp_fm_struct_type
28  USE cp_fm_types, ONLY: cp_fm_create,&
30  cp_fm_release,&
31  cp_fm_to_fm,&
32  cp_fm_type
33  USE dbcsr_api, ONLY: dbcsr_copy,&
34  dbcsr_init_p,&
35  dbcsr_release_p,&
36  dbcsr_type
37  USE kinds, ONLY: dp
38 #include "./base/base_uses.f90"
39 
40  IMPLICIT NONE
41 
42  PRIVATE
43 
44  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_mo_types'
45 
46  TYPE mo_set_type
47  ! The actual MO coefficients as a matrix
48  TYPE(cp_fm_type), POINTER :: mo_coeff => null()
49  TYPE(dbcsr_type), POINTER :: mo_coeff_b => null()
50  ! we are using the dbcsr mo_coeff_b
51  LOGICAL :: use_mo_coeff_b = .false.
52  ! Number of molecular orbitals (# cols in mo_coeff)
53  INTEGER :: nmo = -1
54  ! Number of atomic orbitals (# rows in mo_coeff)
55  INTEGER :: nao = -1
56  ! MO occupation numbers and MO eigenvalues (if eigenstates)
57  REAL(KIND=dp), DIMENSION(:), POINTER :: eigenvalues => null(), &
58  occupation_numbers => null()
59  ! Maximum allowed occupation number of an MO, i.e.
60  ! 1 for spin unrestricted (polarized) and 2 for spin restricted
61  REAL(KIND=dp) :: maxocc = -1
62  ! Number of electrons (taking occupations into account)
63  INTEGER :: nelectron = -1
64  REAL(KIND=dp) :: n_el_f = -1.0_dp
65  ! Highest orbital with non-zero occupation
66  INTEGER :: homo = -1
67  ! lowest non maxocc occupied orbital (e.g. fractional or zero)
68  INTEGER :: lfomo = -1
69  ! True, if all allocated MOs have the same occupation number.
70  ! This is not the case for fractional occupations or for added MOs
71  ! with zero occupation.
72  LOGICAL :: uniform_occupation = .false.
73  ! The entropic energy contribution
74  REAL(KIND=dp) :: kts = -1.0_dp
75  ! Fermi energy level
76  REAL(KIND=dp) :: mu = 0.0_dp
77  ! Threshold value for multiplicity change
78  REAL(KIND=dp) :: flexible_electron_count = -1.0_dp
79  END TYPE mo_set_type
80 
81  TYPE mo_set_p_type
82  TYPE(mo_set_type), POINTER :: mo_set
83  END TYPE mo_set_p_type
84 
85  PUBLIC :: mo_set_p_type, &
86  mo_set_type
87 
88  PUBLIC :: allocate_mo_set, &
91  get_mo_set, &
93  init_mo_set, &
97 
98 CONTAINS
99 
100 ! **************************************************************************************************
101 !> \brief reassign an already allocated mo_set
102 !> \param mo_set_new ...
103 !> \param mo_set_old ...
104 !> \date 2019-05-16
105 !> \par History
106 !> \author Soumya Ghosh
107 ! **************************************************************************************************
108  SUBROUTINE reassign_allocated_mos(mo_set_new, mo_set_old)
109  TYPE(mo_set_type), INTENT(INOUT) :: mo_set_new, mo_set_old
110 
111  INTEGER :: nmo
112 
113  mo_set_new%maxocc = mo_set_old%maxocc
114  mo_set_new%nelectron = mo_set_old%nelectron
115  mo_set_new%n_el_f = mo_set_old%n_el_f
116  mo_set_new%nao = mo_set_old%nao
117  mo_set_new%nmo = mo_set_old%nmo
118  mo_set_new%homo = mo_set_old%homo
119  mo_set_new%lfomo = mo_set_old%lfomo
120  mo_set_new%uniform_occupation = mo_set_old%uniform_occupation
121  mo_set_new%kTS = mo_set_old%kTS
122  mo_set_new%mu = mo_set_old%mu
123  mo_set_new%flexible_electron_count = mo_set_old%flexible_electron_count
124 
125  nmo = mo_set_new%nmo
126 
127  CALL cp_fm_to_fm(mo_set_old%mo_coeff, mo_set_new%mo_coeff)
128 
129  !IF (ASSOCIATED(mo_set_old%mo_coeff_b)) THEN
130  ! CALL dbcsr_copy(mo_set_new%mo_coeff_b, mo_set_old%mo_coeff_b)
131  !END IF
132  !mo_set_new%use_mo_coeff_b = mo_set_old%use_mo_coeff_b
133 
134  mo_set_new%eigenvalues = mo_set_old%eigenvalues
135 
136  mo_set_new%occupation_numbers = mo_set_old%occupation_numbers
137 
138  END SUBROUTINE reassign_allocated_mos
139 
140 ! **************************************************************************************************
141 !> \brief allocate a new mo_set, and copy the old data
142 !> \param mo_set_new ...
143 !> \param mo_set_old ...
144 !> \date 2009-7-19
145 !> \par History
146 !> \author Joost VandeVondele
147 ! **************************************************************************************************
148  SUBROUTINE duplicate_mo_set(mo_set_new, mo_set_old)
149  TYPE(mo_set_type), INTENT(OUT) :: mo_set_new
150  TYPE(mo_set_type), INTENT(IN) :: mo_set_old
151 
152  INTEGER :: nmo
153 
154  mo_set_new%maxocc = mo_set_old%maxocc
155  mo_set_new%nelectron = mo_set_old%nelectron
156  mo_set_new%n_el_f = mo_set_old%n_el_f
157  mo_set_new%nao = mo_set_old%nao
158  mo_set_new%nmo = mo_set_old%nmo
159  mo_set_new%homo = mo_set_old%homo
160  mo_set_new%lfomo = mo_set_old%lfomo
161  mo_set_new%uniform_occupation = mo_set_old%uniform_occupation
162  mo_set_new%kTS = mo_set_old%kTS
163  mo_set_new%mu = mo_set_old%mu
164  mo_set_new%flexible_electron_count = mo_set_old%flexible_electron_count
165 
166  nmo = mo_set_new%nmo
167 
168  NULLIFY (mo_set_new%mo_coeff)
169  ALLOCATE (mo_set_new%mo_coeff)
170  CALL cp_fm_create(mo_set_new%mo_coeff, mo_set_old%mo_coeff%matrix_struct)
171  CALL cp_fm_to_fm(mo_set_old%mo_coeff, mo_set_new%mo_coeff)
172 
173  NULLIFY (mo_set_new%mo_coeff_b)
174  IF (ASSOCIATED(mo_set_old%mo_coeff_b)) THEN
175  CALL dbcsr_init_p(mo_set_new%mo_coeff_b)
176  CALL dbcsr_copy(mo_set_new%mo_coeff_b, mo_set_old%mo_coeff_b)
177  END IF
178  mo_set_new%use_mo_coeff_b = mo_set_old%use_mo_coeff_b
179 
180  ALLOCATE (mo_set_new%eigenvalues(nmo))
181  mo_set_new%eigenvalues = mo_set_old%eigenvalues
182 
183  ALLOCATE (mo_set_new%occupation_numbers(nmo))
184  mo_set_new%occupation_numbers = mo_set_old%occupation_numbers
185 
186  END SUBROUTINE duplicate_mo_set
187 
188 ! **************************************************************************************************
189 !> \brief Allocates a mo set and partially initializes it (nao,nmo,nelectron,
190 !> and flexible_electron_count are valid).
191 !> For the full initialization you need to call init_mo_set
192 !> \param mo_set the mo_set to allocate
193 !> \param nao number of atom orbitals
194 !> \param nmo number of molecular orbitals
195 !> \param nelectron number of electrons
196 !> \param n_el_f ...
197 !> \param maxocc maximum occupation of an orbital (LDA: 2, LSD:1)
198 !> \param flexible_electron_count the number of electrons can be changed
199 !> \date 15.05.2001
200 !> \par History
201 !> 11.2002 splitted initialization in two phases [fawzi]
202 !> \author Matthias Krack
203 ! **************************************************************************************************
204  SUBROUTINE allocate_mo_set(mo_set, nao, nmo, nelectron, n_el_f, maxocc, &
205  flexible_electron_count)
206 
207  TYPE(mo_set_type), INTENT(INOUT) :: mo_set
208  INTEGER, INTENT(IN) :: nao, nmo, nelectron
209  REAL(kind=dp), INTENT(IN) :: n_el_f, maxocc, flexible_electron_count
210 
211  mo_set%maxocc = maxocc
212  mo_set%nelectron = nelectron
213  mo_set%n_el_f = n_el_f
214  mo_set%nao = nao
215  mo_set%nmo = nmo
216  mo_set%homo = 0
217  mo_set%lfomo = 0
218  mo_set%uniform_occupation = .true.
219  mo_set%kTS = 0.0_dp
220  mo_set%mu = 0.0_dp
221  mo_set%flexible_electron_count = flexible_electron_count
222 
223  NULLIFY (mo_set%eigenvalues)
224  NULLIFY (mo_set%occupation_numbers)
225  NULLIFY (mo_set%mo_coeff)
226  NULLIFY (mo_set%mo_coeff_b)
227  mo_set%use_mo_coeff_b = .false.
228 
229  END SUBROUTINE allocate_mo_set
230 
231 ! **************************************************************************************************
232 !> \brief initializes an allocated mo_set.
233 !> eigenvalues, mo_coeff, occupation_numbers are valid only
234 !> after this call.
235 !> \param mo_set the mo_set to initialize
236 !> \param fm_pool a pool out which you initialize the mo_set
237 !> \param fm_ref a reference matrix from which you initialize the mo_set
238 !> \param fm_struct ...
239 !> \param name ...
240 !> \par History
241 !> 11.2002 rewamped [fawzi]
242 !> \author Fawzi Mohamed
243 ! **************************************************************************************************
244  SUBROUTINE init_mo_set(mo_set, fm_pool, fm_ref, fm_struct, name)
245 
246  TYPE(mo_set_type), INTENT(INOUT) :: mo_set
247  TYPE(cp_fm_pool_type), INTENT(IN), OPTIONAL :: fm_pool
248  TYPE(cp_fm_type), INTENT(IN), OPTIONAL :: fm_ref
249  TYPE(cp_fm_struct_type), OPTIONAL, POINTER :: fm_struct
250  CHARACTER(LEN=*), INTENT(in) :: name
251 
252  INTEGER :: nao, nmo, nomo
253 
254  cpassert(.NOT. ASSOCIATED(mo_set%eigenvalues))
255  cpassert(.NOT. ASSOCIATED(mo_set%occupation_numbers))
256  cpassert(.NOT. ASSOCIATED(mo_set%mo_coeff))
257 
258  cpassert(PRESENT(fm_pool) .NEQV. (PRESENT(fm_ref) .NEQV. PRESENT(fm_struct)))
259  NULLIFY (mo_set%mo_coeff)
260  IF (PRESENT(fm_pool)) THEN
261  ALLOCATE (mo_set%mo_coeff)
262  CALL fm_pool_create_fm(fm_pool, mo_set%mo_coeff, name=name)
263  ELSE IF (PRESENT(fm_ref)) THEN
264  ALLOCATE (mo_set%mo_coeff)
265  CALL cp_fm_create(mo_set%mo_coeff, fm_ref%matrix_struct, name=name)
266  ELSE IF (PRESENT(fm_struct)) THEN
267  ALLOCATE (mo_set%mo_coeff)
268  cpassert(ASSOCIATED(fm_struct))
269  CALL cp_fm_create(mo_set%mo_coeff, fm_struct, name=name)
270  END IF
271  CALL cp_fm_get_info(mo_set%mo_coeff, nrow_global=nao, ncol_global=nmo)
272 
273  cpassert(nao >= mo_set%nao)
274  cpassert(nmo >= mo_set%nmo)
275 
276  ALLOCATE (mo_set%eigenvalues(nmo))
277  mo_set%eigenvalues(:) = 0.0_dp
278 
279  ALLOCATE (mo_set%occupation_numbers(nmo))
280  ! Initialize MO occupations
281  mo_set%occupation_numbers(:) = 0.0_dp
282  ! Quick return, if no electrons are available
283  IF (mo_set%nelectron == 0) THEN
284  RETURN
285  END IF
286 
287  IF (modulo(mo_set%nelectron, int(mo_set%maxocc)) == 0) THEN
288  nomo = nint(mo_set%nelectron/mo_set%maxocc)
289  mo_set%occupation_numbers(1:nomo) = mo_set%maxocc
290  ELSE
291  nomo = int(mo_set%nelectron/mo_set%maxocc) + 1
292  ! Initialize MO occupations
293  mo_set%occupation_numbers(1:nomo - 1) = mo_set%maxocc
294  mo_set%occupation_numbers(nomo) = mo_set%nelectron - (nomo - 1)*mo_set%maxocc
295  END IF
296 
297  cpassert(nmo >= nomo)
298  cpassert((SIZE(mo_set%occupation_numbers) == nmo))
299 
300  mo_set%homo = nomo
301  mo_set%lfomo = nomo + 1
302  mo_set%mu = mo_set%eigenvalues(nomo)
303 
304  END SUBROUTINE init_mo_set
305 
306 ! **************************************************************************************************
307 !> \brief make the beta orbitals explicitly equal to the alpha orbitals
308 !> effectively copying the orbital data
309 !> \param mo_array ...
310 !> \param convert_dbcsr ...
311 !> \par History
312 !> 10.2004 created [Joost VandeVondele]
313 ! **************************************************************************************************
314  SUBROUTINE mo_set_restrict(mo_array, convert_dbcsr)
315  TYPE(mo_set_type), DIMENSION(2), INTENT(IN) :: mo_array
316  LOGICAL, INTENT(in), OPTIONAL :: convert_dbcsr
317 
318  CHARACTER(LEN=*), PARAMETER :: routinen = 'mo_set_restrict'
319 
320  INTEGER :: handle
321  LOGICAL :: my_convert_dbcsr
322 
323  CALL timeset(routinen, handle)
324 
325  my_convert_dbcsr = .false.
326  IF (PRESENT(convert_dbcsr)) my_convert_dbcsr = convert_dbcsr
327 
328  cpassert(mo_array(1)%nmo >= mo_array(2)%nmo)
329 
330  ! first nmo_beta orbitals are copied from alpha to beta
331  IF (my_convert_dbcsr) THEN !fm->dbcsr
332  CALL dbcsr_copy_columns_hack(mo_array(2)%mo_coeff_b, mo_array(1)%mo_coeff_b, & !fm->dbcsr
333  mo_array(2)%nmo, 1, 1, & !fm->dbcsr
334  para_env=mo_array(1)%mo_coeff%matrix_struct%para_env, & !fm->dbcsr
335  blacs_env=mo_array(1)%mo_coeff%matrix_struct%context) !fm->dbcsr
336  ELSE !fm->dbcsr
337  CALL cp_fm_to_fm(mo_array(1)%mo_coeff, mo_array(2)%mo_coeff, mo_array(2)%nmo)
338  END IF
339 
340  CALL timestop(handle)
341 
342  END SUBROUTINE mo_set_restrict
343 
344 ! **************************************************************************************************
345 !> \brief Deallocate a wavefunction data structure.
346 !> \param mo_set ...
347 !> \date 15.05.2001
348 !> \author MK
349 !> \version 1.0
350 ! **************************************************************************************************
351  SUBROUTINE deallocate_mo_set(mo_set)
352 
353  TYPE(mo_set_type), INTENT(INOUT) :: mo_set
354 
355  IF (ASSOCIATED(mo_set%eigenvalues)) THEN
356  DEALLOCATE (mo_set%eigenvalues)
357  NULLIFY (mo_set%eigenvalues)
358  END IF
359  IF (ASSOCIATED(mo_set%occupation_numbers)) THEN
360  DEALLOCATE (mo_set%occupation_numbers)
361  NULLIFY (mo_set%occupation_numbers)
362  END IF
363  IF (ASSOCIATED(mo_set%mo_coeff)) THEN
364  CALL cp_fm_release(mo_set%mo_coeff)
365  DEALLOCATE (mo_set%mo_coeff)
366  NULLIFY (mo_set%mo_coeff)
367  END IF
368  IF (ASSOCIATED(mo_set%mo_coeff_b)) CALL dbcsr_release_p(mo_set%mo_coeff_b)
369 
370  END SUBROUTINE deallocate_mo_set
371 
372 ! **************************************************************************************************
373 !> \brief Get the components of a MO set data structure.
374 !> \param mo_set ...
375 !> \param maxocc ...
376 !> \param homo ...
377 !> \param lfomo ...
378 !> \param nao ...
379 !> \param nelectron ...
380 !> \param n_el_f ...
381 !> \param nmo ...
382 !> \param eigenvalues ...
383 !> \param occupation_numbers ...
384 !> \param mo_coeff ...
385 !> \param mo_coeff_b ...
386 !> \param uniform_occupation ...
387 !> \param kTS ...
388 !> \param mu ...
389 !> \param flexible_electron_count ...
390 !> \date 22.04.2002
391 !> \author MK
392 !> \version 1.0
393 ! **************************************************************************************************
394  SUBROUTINE get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, &
395  eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, &
396  uniform_occupation, kTS, mu, flexible_electron_count)
397 
398  TYPE(mo_set_type), INTENT(IN) :: mo_set
399  REAL(kind=dp), INTENT(OUT), OPTIONAL :: maxocc
400  INTEGER, INTENT(OUT), OPTIONAL :: homo, lfomo, nao, nelectron
401  REAL(kind=dp), INTENT(OUT), OPTIONAL :: n_el_f
402  INTEGER, INTENT(OUT), OPTIONAL :: nmo
403  REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: eigenvalues, occupation_numbers
404  TYPE(cp_fm_type), OPTIONAL, POINTER :: mo_coeff
405  TYPE(dbcsr_type), OPTIONAL, POINTER :: mo_coeff_b
406  LOGICAL, INTENT(OUT), OPTIONAL :: uniform_occupation
407  REAL(kind=dp), INTENT(OUT), OPTIONAL :: kts, mu, flexible_electron_count
408 
409  IF (PRESENT(maxocc)) maxocc = mo_set%maxocc
410  IF (PRESENT(homo)) homo = mo_set%homo
411  IF (PRESENT(lfomo)) lfomo = mo_set%lfomo
412  IF (PRESENT(nao)) nao = mo_set%nao
413  IF (PRESENT(nelectron)) nelectron = mo_set%nelectron
414  IF (PRESENT(n_el_f)) n_el_f = mo_set%n_el_f
415  IF (PRESENT(nmo)) nmo = mo_set%nmo
416  IF (PRESENT(eigenvalues)) eigenvalues => mo_set%eigenvalues
417  IF (PRESENT(occupation_numbers)) THEN
418  occupation_numbers => mo_set%occupation_numbers
419  END IF
420  IF (PRESENT(mo_coeff)) mo_coeff => mo_set%mo_coeff
421  IF (PRESENT(mo_coeff_b)) mo_coeff_b => mo_set%mo_coeff_b
422  IF (PRESENT(uniform_occupation)) uniform_occupation = mo_set%uniform_occupation
423  IF (PRESENT(kts)) kts = mo_set%kTS
424  IF (PRESENT(mu)) mu = mo_set%mu
425  IF (PRESENT(flexible_electron_count)) flexible_electron_count = mo_set%flexible_electron_count
426 
427  END SUBROUTINE get_mo_set
428 
429 ! **************************************************************************************************
430 !> \brief Set the components of a MO set data structure.
431 !> \param mo_set ...
432 !> \param maxocc ...
433 !> \param homo ...
434 !> \param lfomo ...
435 !> \param nao ...
436 !> \param nelectron ...
437 !> \param n_el_f ...
438 !> \param nmo ...
439 !> \param eigenvalues ...
440 !> \param occupation_numbers ...
441 !> \param uniform_occupation ...
442 !> \param kTS ...
443 !> \param mu ...
444 !> \param flexible_electron_count ...
445 !> \date 22.04.2002
446 !> \author MK
447 !> \version 1.0
448 ! **************************************************************************************************
449  SUBROUTINE set_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, &
450  eigenvalues, occupation_numbers, uniform_occupation, &
451  kTS, mu, flexible_electron_count)
452 
453  TYPE(mo_set_type), INTENT(INOUT) :: mo_set
454  REAL(kind=dp), INTENT(IN), OPTIONAL :: maxocc
455  INTEGER, INTENT(IN), OPTIONAL :: homo, lfomo, nao, nelectron
456  REAL(kind=dp), INTENT(IN), OPTIONAL :: n_el_f
457  INTEGER, INTENT(IN), OPTIONAL :: nmo
458  REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: eigenvalues, occupation_numbers
459  LOGICAL, INTENT(IN), OPTIONAL :: uniform_occupation
460  REAL(kind=dp), INTENT(IN), OPTIONAL :: kts, mu, flexible_electron_count
461 
462  IF (PRESENT(maxocc)) mo_set%maxocc = maxocc
463  IF (PRESENT(homo)) mo_set%homo = homo
464  IF (PRESENT(lfomo)) mo_set%lfomo = lfomo
465  IF (PRESENT(nao)) mo_set%nao = nao
466  IF (PRESENT(nelectron)) mo_set%nelectron = nelectron
467  IF (PRESENT(n_el_f)) mo_set%n_el_f = n_el_f
468  IF (PRESENT(nmo)) mo_set%nmo = nmo
469  IF (PRESENT(eigenvalues)) THEN
470  IF (ASSOCIATED(mo_set%eigenvalues)) THEN
471  DEALLOCATE (mo_set%eigenvalues)
472  END IF
473  mo_set%eigenvalues => eigenvalues
474  END IF
475  IF (PRESENT(occupation_numbers)) THEN
476  IF (ASSOCIATED(mo_set%occupation_numbers)) THEN
477  DEALLOCATE (mo_set%occupation_numbers)
478  END IF
479  mo_set%occupation_numbers => occupation_numbers
480  END IF
481  IF (PRESENT(uniform_occupation)) mo_set%uniform_occupation = uniform_occupation
482  IF (PRESENT(kts)) mo_set%kTS = kts
483  IF (PRESENT(mu)) mo_set%mu = mu
484  IF (PRESENT(flexible_electron_count)) mo_set%flexible_electron_count = flexible_electron_count
485 
486  END SUBROUTINE set_mo_set
487 
488 ! **************************************************************************************************
489 !> \brief Check if the set of MOs in mo_set specifed by the MO index range [first_mo,last_mo]
490 !> an integer occupation within a tolerance.
491 !> \param mo_set :: MO set for which the uniform occupation will be checked
492 !> \param first_mo :: Index of first MO for the checked MO range
493 !> \param last_mo :: Index of last MO for the checked MO range
494 !> \param occupation :: Requested uniform MO occupation with the MO range
495 !> \param tolerance :: Requested numerical tolerance for an integer occupation
496 !> \return has_uniform_occupation :: boolean, true if an integer occupation is found otherwise false
497 !> \par History
498 !> 04.08.2021 Created (MK)
499 !> \author Matthias Krack (MK)
500 !> \version 1.0
501 ! **************************************************************************************************
502  FUNCTION has_uniform_occupation(mo_set, first_mo, last_mo, occupation, tolerance)
503 
504  TYPE(mo_set_type), INTENT(IN) :: mo_set
505  INTEGER, INTENT(IN), OPTIONAL :: first_mo, last_mo
506  REAL(kind=dp), INTENT(IN), OPTIONAL :: occupation, tolerance
507  LOGICAL :: has_uniform_occupation
508 
509  INTEGER :: my_first_mo, my_last_mo
510  REAL(kind=dp) :: my_occupation, my_tolerance
511 
512  has_uniform_occupation = .false.
513 
514  IF (PRESENT(first_mo)) THEN
515  cpassert(first_mo >= lbound(mo_set%eigenvalues, 1))
516  my_first_mo = first_mo
517  ELSE
518  my_first_mo = lbound(mo_set%eigenvalues, 1)
519  END IF
520 
521  IF (PRESENT(last_mo)) THEN
522  cpassert(last_mo <= ubound(mo_set%eigenvalues, 1))
523  my_last_mo = last_mo
524  ELSE
525  my_last_mo = ubound(mo_set%eigenvalues, 1)
526  END IF
527 
528  IF (PRESENT(occupation)) THEN
529  my_occupation = occupation
530  ELSE
531  my_occupation = mo_set%maxocc
532  END IF
533 
534  IF (PRESENT(tolerance)) THEN
535  my_tolerance = tolerance
536  ELSE
537  my_tolerance = epsilon(0.0_dp)
538  END IF
539 
540  has_uniform_occupation = all(abs(mo_set%occupation_numbers(my_first_mo:my_last_mo) - my_occupation) < my_tolerance)
541 
542  END FUNCTION has_uniform_occupation
543 
544 END MODULE qs_mo_types
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Definition: grid_common.h:117
DBCSR operations in CP2K.
subroutine, public dbcsr_copy_columns_hack(matrix_b, matrix_a, ncol, source_start, target_start, para_env, blacs_env)
hack for dbcsr_copy_columns
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
Definition: cp_fm_struct.F:14
represent a full matrix distributed on many processors
Definition: cp_fm_types.F:15
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
Definition: cp_fm_types.F:1016
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
Definition: cp_fm_types.F:167
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
Definition and initialisation of the mo data type.
Definition: qs_mo_types.F:22
subroutine, public duplicate_mo_set(mo_set_new, mo_set_old)
allocate a new mo_set, and copy the old data
Definition: qs_mo_types.F:149
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.
Definition: qs_mo_types.F:452
subroutine, public allocate_mo_set(mo_set, nao, nmo, nelectron, n_el_f, maxocc, flexible_electron_count)
Allocates a mo set and partially initializes it (nao,nmo,nelectron, and flexible_electron_count are v...
Definition: qs_mo_types.F:206
subroutine, public mo_set_restrict(mo_array, convert_dbcsr)
make the beta orbitals explicitly equal to the alpha orbitals effectively copying the orbital data
Definition: qs_mo_types.F:315
subroutine, public deallocate_mo_set(mo_set)
Deallocate a wavefunction data structure.
Definition: qs_mo_types.F:352
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.
Definition: qs_mo_types.F:397
logical function, public has_uniform_occupation(mo_set, first_mo, last_mo, occupation, tolerance)
Check if the set of MOs in mo_set specifed by the MO index range [first_mo,last_mo] an integer occupa...
Definition: qs_mo_types.F:503
subroutine, public reassign_allocated_mos(mo_set_new, mo_set_old)
reassign an already allocated mo_set
Definition: qs_mo_types.F:109
subroutine, public init_mo_set(mo_set, fm_pool, fm_ref, fm_struct, name)
initializes an allocated mo_set. eigenvalues, mo_coeff, occupation_numbers are valid only after this ...
Definition: qs_mo_types.F:245