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