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