Line data Source code
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 : ! **************************************************************************************************
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_to_fm,&
36 : cp_fm_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 => NULL()
83 : END TYPE mo_set_p_type
84 :
85 : PUBLIC :: mo_set_p_type, &
86 : mo_set_type
87 :
88 : PUBLIC :: allocate_mo_set, &
89 : deallocate_mo_set, &
90 : duplicate_mo_set, &
91 : get_mo_set, &
92 : has_uniform_occupation, &
93 : init_mo_set, &
94 : mo_set_restrict, &
95 : reassign_allocated_mos, &
96 : set_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 8 : 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 8 : mo_set_new%maxocc = mo_set_old%maxocc
114 8 : mo_set_new%nelectron = mo_set_old%nelectron
115 8 : mo_set_new%n_el_f = mo_set_old%n_el_f
116 8 : mo_set_new%nao = mo_set_old%nao
117 8 : mo_set_new%nmo = mo_set_old%nmo
118 8 : mo_set_new%homo = mo_set_old%homo
119 8 : mo_set_new%lfomo = mo_set_old%lfomo
120 8 : mo_set_new%uniform_occupation = mo_set_old%uniform_occupation
121 8 : mo_set_new%kTS = mo_set_old%kTS
122 8 : mo_set_new%mu = mo_set_old%mu
123 8 : mo_set_new%flexible_electron_count = mo_set_old%flexible_electron_count
124 :
125 8 : nmo = mo_set_new%nmo
126 :
127 8 : 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 332 : mo_set_new%eigenvalues = mo_set_old%eigenvalues
135 :
136 332 : mo_set_new%occupation_numbers = mo_set_old%occupation_numbers
137 :
138 8 : 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 464 : 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 464 : mo_set_new%maxocc = mo_set_old%maxocc
155 464 : mo_set_new%nelectron = mo_set_old%nelectron
156 464 : mo_set_new%n_el_f = mo_set_old%n_el_f
157 464 : mo_set_new%nao = mo_set_old%nao
158 464 : mo_set_new%nmo = mo_set_old%nmo
159 464 : mo_set_new%homo = mo_set_old%homo
160 464 : mo_set_new%lfomo = mo_set_old%lfomo
161 464 : mo_set_new%uniform_occupation = mo_set_old%uniform_occupation
162 464 : mo_set_new%kTS = mo_set_old%kTS
163 464 : mo_set_new%mu = mo_set_old%mu
164 464 : mo_set_new%flexible_electron_count = mo_set_old%flexible_electron_count
165 :
166 464 : nmo = mo_set_new%nmo
167 :
168 : NULLIFY (mo_set_new%mo_coeff)
169 464 : ALLOCATE (mo_set_new%mo_coeff)
170 464 : CALL cp_fm_create(mo_set_new%mo_coeff, mo_set_old%mo_coeff%matrix_struct)
171 464 : CALL cp_fm_to_fm(mo_set_old%mo_coeff, mo_set_new%mo_coeff)
172 :
173 464 : NULLIFY (mo_set_new%mo_coeff_b)
174 464 : IF (ASSOCIATED(mo_set_old%mo_coeff_b)) THEN
175 452 : CALL dbcsr_init_p(mo_set_new%mo_coeff_b)
176 452 : CALL dbcsr_copy(mo_set_new%mo_coeff_b, mo_set_old%mo_coeff_b)
177 : END IF
178 464 : mo_set_new%use_mo_coeff_b = mo_set_old%use_mo_coeff_b
179 :
180 1392 : ALLOCATE (mo_set_new%eigenvalues(nmo))
181 1604 : mo_set_new%eigenvalues = mo_set_old%eigenvalues
182 :
183 1392 : ALLOCATE (mo_set_new%occupation_numbers(nmo))
184 1604 : mo_set_new%occupation_numbers = mo_set_old%occupation_numbers
185 :
186 464 : 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 16393 : 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 16393 : mo_set%maxocc = maxocc
212 16393 : mo_set%nelectron = nelectron
213 16393 : mo_set%n_el_f = n_el_f
214 16393 : mo_set%nao = nao
215 16393 : mo_set%nmo = nmo
216 16393 : mo_set%homo = 0
217 16393 : mo_set%lfomo = 0
218 16393 : mo_set%uniform_occupation = .TRUE.
219 16393 : mo_set%kTS = 0.0_dp
220 16393 : mo_set%mu = 0.0_dp
221 16393 : mo_set%flexible_electron_count = flexible_electron_count
222 :
223 16393 : NULLIFY (mo_set%eigenvalues)
224 16393 : NULLIFY (mo_set%occupation_numbers)
225 16393 : NULLIFY (mo_set%mo_coeff)
226 16393 : NULLIFY (mo_set%mo_coeff_b)
227 16393 : mo_set%use_mo_coeff_b = .FALSE.
228 :
229 16393 : 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 15495 : 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 15495 : CPASSERT(.NOT. ASSOCIATED(mo_set%eigenvalues))
255 15495 : CPASSERT(.NOT. ASSOCIATED(mo_set%occupation_numbers))
256 15495 : CPASSERT(.NOT. ASSOCIATED(mo_set%mo_coeff))
257 :
258 15495 : CPASSERT(PRESENT(fm_pool) .NEQV. (PRESENT(fm_ref) .NEQV. PRESENT(fm_struct)))
259 15495 : NULLIFY (mo_set%mo_coeff)
260 15495 : IF (PRESENT(fm_pool)) THEN
261 11669 : ALLOCATE (mo_set%mo_coeff)
262 11669 : CALL fm_pool_create_fm(fm_pool, mo_set%mo_coeff, name=name)
263 3826 : ELSE IF (PRESENT(fm_ref)) THEN
264 642 : ALLOCATE (mo_set%mo_coeff)
265 642 : CALL cp_fm_create(mo_set%mo_coeff, fm_ref%matrix_struct, name=name)
266 3184 : ELSE IF (PRESENT(fm_struct)) THEN
267 3184 : ALLOCATE (mo_set%mo_coeff)
268 3184 : CPASSERT(ASSOCIATED(fm_struct))
269 3184 : CALL cp_fm_create(mo_set%mo_coeff, fm_struct, name=name)
270 : END IF
271 15495 : CALL cp_fm_get_info(mo_set%mo_coeff, nrow_global=nao, ncol_global=nmo)
272 :
273 15495 : CPASSERT(nao >= mo_set%nao)
274 15495 : CPASSERT(nmo >= mo_set%nmo)
275 :
276 46327 : ALLOCATE (mo_set%eigenvalues(nmo))
277 206070 : mo_set%eigenvalues(:) = 0.0_dp
278 :
279 30832 : ALLOCATE (mo_set%occupation_numbers(nmo))
280 : ! Initialize MO occupations
281 206070 : mo_set%occupation_numbers(:) = 0.0_dp
282 : ! Quick return, if no electrons are available
283 15495 : IF (mo_set%nelectron == 0) THEN
284 918 : RETURN
285 : END IF
286 :
287 14577 : IF (MODULO(mo_set%nelectron, INT(mo_set%maxocc)) == 0) THEN
288 14565 : nomo = NINT(mo_set%nelectron/mo_set%maxocc)
289 123258 : mo_set%occupation_numbers(1:nomo) = mo_set%maxocc
290 : ELSE
291 12 : nomo = INT(mo_set%nelectron/mo_set%maxocc) + 1
292 : ! Initialize MO occupations
293 146 : mo_set%occupation_numbers(1:nomo - 1) = mo_set%maxocc
294 12 : mo_set%occupation_numbers(nomo) = mo_set%nelectron - (nomo - 1)*mo_set%maxocc
295 : END IF
296 :
297 14577 : CPASSERT(nmo >= nomo)
298 14577 : CPASSERT((SIZE(mo_set%occupation_numbers) == nmo))
299 :
300 14577 : mo_set%homo = nomo
301 14577 : mo_set%lfomo = nomo + 1
302 14577 : mo_set%mu = mo_set%eigenvalues(nomo)
303 :
304 15495 : 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 682 : 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 682 : CALL timeset(routineN, handle)
324 :
325 682 : my_convert_dbcsr = .FALSE.
326 682 : IF (PRESENT(convert_dbcsr)) my_convert_dbcsr = convert_dbcsr
327 :
328 682 : CPASSERT(mo_array(1)%nmo >= mo_array(2)%nmo)
329 :
330 : ! first nmo_beta orbitals are copied from alpha to beta
331 682 : 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 638 : blacs_env=mo_array(1)%mo_coeff%matrix_struct%context) !fm->dbcsr
336 : ELSE !fm->dbcsr
337 44 : CALL cp_fm_to_fm(mo_array(1)%mo_coeff, mo_array(2)%mo_coeff, mo_array(2)%nmo)
338 : END IF
339 :
340 682 : CALL timestop(handle)
341 :
342 682 : 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 17011 : SUBROUTINE deallocate_mo_set(mo_set)
352 :
353 : TYPE(mo_set_type), INTENT(INOUT) :: mo_set
354 :
355 17011 : IF (ASSOCIATED(mo_set%eigenvalues)) THEN
356 16119 : DEALLOCATE (mo_set%eigenvalues)
357 : NULLIFY (mo_set%eigenvalues)
358 : END IF
359 17011 : IF (ASSOCIATED(mo_set%occupation_numbers)) THEN
360 16119 : DEALLOCATE (mo_set%occupation_numbers)
361 : NULLIFY (mo_set%occupation_numbers)
362 : END IF
363 17011 : IF (ASSOCIATED(mo_set%mo_coeff)) THEN
364 16119 : CALL cp_fm_release(mo_set%mo_coeff)
365 16119 : DEALLOCATE (mo_set%mo_coeff)
366 : NULLIFY (mo_set%mo_coeff)
367 : END IF
368 17011 : IF (ASSOCIATED(mo_set%mo_coeff_b)) CALL dbcsr_release_p(mo_set%mo_coeff_b)
369 :
370 17011 : 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 804473 : 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 804473 : IF (PRESENT(maxocc)) maxocc = mo_set%maxocc
410 804473 : IF (PRESENT(homo)) homo = mo_set%homo
411 804473 : IF (PRESENT(lfomo)) lfomo = mo_set%lfomo
412 804473 : IF (PRESENT(nao)) nao = mo_set%nao
413 804473 : IF (PRESENT(nelectron)) nelectron = mo_set%nelectron
414 804473 : IF (PRESENT(n_el_f)) n_el_f = mo_set%n_el_f
415 804473 : IF (PRESENT(nmo)) nmo = mo_set%nmo
416 804473 : IF (PRESENT(eigenvalues)) eigenvalues => mo_set%eigenvalues
417 804473 : IF (PRESENT(occupation_numbers)) THEN
418 287725 : occupation_numbers => mo_set%occupation_numbers
419 : END IF
420 804473 : IF (PRESENT(mo_coeff)) mo_coeff => mo_set%mo_coeff
421 804473 : IF (PRESENT(mo_coeff_b)) mo_coeff_b => mo_set%mo_coeff_b
422 804473 : IF (PRESENT(uniform_occupation)) uniform_occupation = mo_set%uniform_occupation
423 804473 : IF (PRESENT(kTS)) kTS = mo_set%kTS
424 804473 : IF (PRESENT(mu)) mu = mo_set%mu
425 804473 : IF (PRESENT(flexible_electron_count)) flexible_electron_count = mo_set%flexible_electron_count
426 :
427 804473 : 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 1910 : 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 1910 : IF (PRESENT(maxocc)) mo_set%maxocc = maxocc
463 1910 : IF (PRESENT(homo)) mo_set%homo = homo
464 1910 : IF (PRESENT(lfomo)) mo_set%lfomo = lfomo
465 1910 : IF (PRESENT(nao)) mo_set%nao = nao
466 1910 : IF (PRESENT(nelectron)) mo_set%nelectron = nelectron
467 1910 : IF (PRESENT(n_el_f)) mo_set%n_el_f = n_el_f
468 1910 : IF (PRESENT(nmo)) mo_set%nmo = nmo
469 1910 : IF (PRESENT(eigenvalues)) THEN
470 0 : IF (ASSOCIATED(mo_set%eigenvalues)) THEN
471 0 : DEALLOCATE (mo_set%eigenvalues)
472 : END IF
473 0 : mo_set%eigenvalues => eigenvalues
474 : END IF
475 1910 : IF (PRESENT(occupation_numbers)) THEN
476 0 : IF (ASSOCIATED(mo_set%occupation_numbers)) THEN
477 0 : DEALLOCATE (mo_set%occupation_numbers)
478 : END IF
479 0 : mo_set%occupation_numbers => occupation_numbers
480 : END IF
481 1910 : IF (PRESENT(uniform_occupation)) mo_set%uniform_occupation = uniform_occupation
482 1910 : IF (PRESENT(kTS)) mo_set%kTS = kTS
483 1910 : IF (PRESENT(mu)) mo_set%mu = mu
484 1910 : IF (PRESENT(flexible_electron_count)) mo_set%flexible_electron_count = flexible_electron_count
485 :
486 1910 : 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 113097 : 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 113097 : has_uniform_occupation = .FALSE.
513 :
514 113097 : IF (PRESENT(first_mo)) THEN
515 0 : CPASSERT(first_mo >= LBOUND(mo_set%eigenvalues, 1))
516 : my_first_mo = first_mo
517 : ELSE
518 113097 : my_first_mo = LBOUND(mo_set%eigenvalues, 1)
519 : END IF
520 :
521 113097 : IF (PRESENT(last_mo)) THEN
522 7100 : CPASSERT(last_mo <= UBOUND(mo_set%eigenvalues, 1))
523 : my_last_mo = last_mo
524 : ELSE
525 109453 : my_last_mo = UBOUND(mo_set%eigenvalues, 1)
526 : END IF
527 :
528 113097 : IF (PRESENT(occupation)) THEN
529 0 : my_occupation = occupation
530 : ELSE
531 113097 : my_occupation = mo_set%maxocc
532 : END IF
533 :
534 113097 : IF (PRESENT(tolerance)) THEN
535 0 : my_tolerance = tolerance
536 : ELSE
537 : my_tolerance = EPSILON(0.0_dp)
538 : END IF
539 :
540 884323 : has_uniform_occupation = ALL(ABS(mo_set%occupation_numbers(my_first_mo:my_last_mo) - my_occupation) < my_tolerance)
541 :
542 113097 : END FUNCTION has_uniform_occupation
543 :
544 0 : END MODULE qs_mo_types
|
