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