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 : MODULE qs_tddfpt2_smearing_methods
9 : USE cp_blacs_env, ONLY: cp_blacs_env_type
10 : USE cp_control_types, ONLY: dft_control_type,&
11 : smeared_type,&
12 : tddfpt2_control_type
13 : USE cp_dbcsr_api, ONLY: dbcsr_type
14 : USE cp_dbcsr_operations, ONLY: cp_dbcsr_sm_fm_multiply
15 : USE cp_fm_basic_linalg, ONLY: cp_fm_column_scale,&
16 : cp_fm_scale_and_add
17 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
18 : cp_fm_struct_release,&
19 : cp_fm_struct_type
20 : USE cp_fm_types, ONLY: cp_fm_copy_general,&
21 : cp_fm_create,&
22 : cp_fm_get_info,&
23 : cp_fm_release,&
24 : cp_fm_to_fm,&
25 : cp_fm_type
26 : USE cp_log_handling, ONLY: cp_get_default_logger,&
27 : cp_logger_get_default_io_unit,&
28 : cp_logger_type
29 : USE input_constants, ONLY: smear_fermi_dirac
30 : USE kinds, ONLY: dp
31 : USE message_passing, ONLY: mp_para_env_type
32 : USE parallel_gemm_api, ONLY: parallel_gemm
33 : USE qs_environment_types, ONLY: get_qs_env,&
34 : qs_environment_type
35 : USE qs_mo_types, ONLY: get_mo_set,&
36 : mo_set_type
37 : USE qs_tddfpt2_types, ONLY: tddfpt_ground_state_mos
38 : USE scf_control_types, ONLY: scf_control_type,&
39 : smear_type
40 : USE smearing_utils, ONLY: SmearOcc
41 : #include "./base/base_uses.f90"
42 :
43 : IMPLICIT NONE
44 :
45 : PRIVATE
46 :
47 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_tddfpt2_smearing_methods'
48 :
49 : LOGICAL, PARAMETER, PRIVATE :: debug_this_module = .FALSE.
50 :
51 : PUBLIC :: tddfpt_smeared_occupation, &
52 : add_smearing_aterm, compute_fermib, &
53 : orthogonalize_smeared_occupation, deallocate_fermi_params
54 :
55 : CONTAINS
56 :
57 : ! **************************************************************************************************
58 : !> \brief ...
59 : !> \param qs_env ...
60 : !> \param gs_mos ...
61 : !> \param log_unit ...
62 : ! **************************************************************************************************
63 2 : SUBROUTINE tddfpt_smeared_occupation(qs_env, gs_mos, log_unit)
64 :
65 : TYPE(qs_environment_type), POINTER :: qs_env
66 : TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
67 : INTENT(IN), POINTER :: gs_mos
68 : INTEGER, INTENT(in) :: log_unit
69 :
70 : CHARACTER(len=*), PARAMETER :: routineN = 'tddfpt_smeared_occupation'
71 :
72 : INTEGER :: handle, iocc, ispin, nspins
73 2 : INTEGER, ALLOCATABLE, DIMENSION(:) :: nocc, nvirt
74 2 : REAL(kind=dp), DIMENSION(:), POINTER :: mo_evals, occup
75 2 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
76 : TYPE(scf_control_type), POINTER :: scf_control
77 : TYPE(smear_type), POINTER :: smear
78 :
79 2 : CALL timeset(routineN, handle)
80 :
81 2 : nspins = SIZE(gs_mos)
82 :
83 2 : NULLIFY (mos, scf_control)
84 2 : CALL get_qs_env(qs_env, mos=mos, scf_control=scf_control)
85 2 : NULLIFY (smear)
86 2 : IF (ASSOCIATED(qs_env%scf_control%smear)) THEN
87 2 : smear => qs_env%scf_control%smear
88 : ELSE
89 0 : CPABORT("Smeared input section no longer associated.")
90 : END IF
91 :
92 : IF (debug_this_module) THEN
93 : NULLIFY (mo_evals, occup)
94 : ALLOCATE (nocc(nspins), nvirt(nspins))
95 : DO ispin = 1, nspins
96 : CALL get_mo_set(mos(ispin), eigenvalues=mo_evals, occupation_numbers=occup)
97 : CALL cp_fm_get_info(gs_mos(ispin)%mos_occ, ncol_global=nocc(ispin))
98 : CALL cp_fm_get_info(gs_mos(ispin)%mos_virt, ncol_global=nvirt(ispin))
99 : IF (log_unit > 0) THEN
100 : DO iocc = 1, nocc(ispin)
101 : WRITE (log_unit, '(A,F14.5)') "Occupation numbers", occup(iocc)
102 : END DO
103 : END IF
104 : END DO
105 : END IF
106 :
107 2 : CALL allocate_fermi_params(qs_env, gs_mos)
108 2 : CALL compute_fermia(qs_env, gs_mos, log_unit)
109 :
110 2 : CALL timestop(handle)
111 :
112 2 : END SUBROUTINE tddfpt_smeared_occupation
113 : ! **************************************************************************************************
114 : !> \brief ...
115 : !> \param qs_env ...
116 : !> \param gs_mos ...
117 : !> \param log_unit ...
118 : ! **************************************************************************************************
119 2 : SUBROUTINE compute_fermia(qs_env, gs_mos, log_unit)
120 :
121 : TYPE(qs_environment_type), POINTER :: qs_env
122 : TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
123 : INTENT(IN), POINTER :: gs_mos
124 : INTEGER, INTENT(IN) :: log_unit
125 :
126 : CHARACTER(len=*), PARAMETER :: routineN = 'compute_fermia'
127 :
128 : INTEGER :: handle, iocc, ispin, nocc, nspins
129 : REAL(kind=dp) :: maxvalue, mu
130 2 : REAL(kind=dp), DIMENSION(:), POINTER :: fermia, mo_evals
131 : TYPE(dft_control_type), POINTER :: dft_control
132 2 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
133 : TYPE(scf_control_type), POINTER :: scf_control
134 : TYPE(smear_type), POINTER :: smear
135 : TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
136 :
137 2 : CALL timeset(routineN, handle)
138 :
139 2 : NULLIFY (mos, dft_control, tddfpt_control, scf_control)
140 2 : CALL get_qs_env(qs_env, dft_control=dft_control, scf_control=scf_control)
141 2 : tddfpt_control => dft_control%tddfpt2_control
142 :
143 2 : CALL get_qs_env(qs_env, mos=mos)
144 2 : nspins = SIZE(mos)
145 :
146 2 : NULLIFY (smear)
147 2 : IF (ASSOCIATED(qs_env%scf_control%smear)) THEN
148 : smear => qs_env%scf_control%smear
149 : ELSE
150 0 : CPABORT("Smeared input section no longer associated.")
151 : END IF
152 :
153 : IF (debug_this_module .AND. (log_unit > 0)) THEN
154 : WRITE (log_unit, '(A,F14.5)') "Smearing temperature", smear%electronic_temperature
155 : END IF
156 :
157 2 : NULLIFY (mo_evals)
158 4 : DO ispin = 1, nspins
159 2 : CALL get_mo_set(mos(ispin), eigenvalues=mo_evals, mu=mu)
160 2 : CALL cp_fm_get_info(gs_mos(ispin)%mos_occ, ncol_global=nocc)
161 2 : fermia => tddfpt_control%smeared_occup(ispin)%fermia
162 12 : DO iocc = 1, nocc
163 8 : maxvalue = mu + 3.0_dp*smear%electronic_temperature - mo_evals(iocc)
164 :
165 8 : fermia(iocc) = MAX(0.0_dp, maxvalue)
166 2 : IF (debug_this_module) THEN
167 : IF (log_unit > 0) WRITE (log_unit, '(A,F14.5)') "Fermi smearing parameter alpha", fermia(iocc)
168 : END IF
169 : END DO
170 : END DO
171 :
172 2 : CALL timestop(handle)
173 2 : END SUBROUTINE compute_fermia
174 : ! **************************************************************************************************
175 :
176 : ! **************************************************************************************************
177 : !> \brief ...
178 : !> \param qs_env ...
179 : !> \param Aop_evects ...
180 : !> \param evects ...
181 : !> \param S_evects ...
182 : !> \param mos_occ ...
183 : !> \param fermia ...
184 : !> \param matrix_s ...
185 : ! **************************************************************************************************
186 72 : SUBROUTINE add_smearing_aterm(qs_env, Aop_evects, evects, S_evects, mos_occ, fermia, matrix_s)
187 :
188 : TYPE(qs_environment_type), POINTER :: qs_env
189 : TYPE(cp_fm_type), INTENT(in) :: Aop_evects, evects, S_evects, mos_occ
190 : REAL(kind=dp), DIMENSION(:), POINTER :: fermia
191 : TYPE(dbcsr_type), POINTER :: matrix_s
192 :
193 : CHARACTER(len=*), PARAMETER :: routineN = 'add_smearing_aterm'
194 :
195 : INTEGER :: handle, iounit, nactive, nao
196 : TYPE(cp_fm_struct_type), POINTER :: matrix_struct, matrix_struct_tmp
197 : TYPE(cp_fm_type) :: CCSXvec, CSXvec, Cvec, SCCSXvec
198 : TYPE(cp_logger_type), POINTER :: logger
199 : TYPE(dft_control_type), POINTER :: dft_control
200 : TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
201 :
202 12 : CALL timeset(routineN, handle)
203 :
204 12 : NULLIFY (logger)
205 12 : logger => cp_get_default_logger()
206 12 : iounit = cp_logger_get_default_io_unit(logger)
207 :
208 12 : NULLIFY (dft_control, tddfpt_control)
209 12 : CALL get_qs_env(qs_env, dft_control=dft_control)
210 12 : tddfpt_control => dft_control%tddfpt2_control
211 :
212 : CALL cp_fm_get_info(matrix=evects, matrix_struct=matrix_struct, &
213 12 : nrow_global=nao, ncol_global=nactive)
214 12 : CALL cp_fm_create(CCSXvec, matrix_struct)
215 12 : CALL cp_fm_create(SCCSXvec, matrix_struct)
216 12 : CALL cp_fm_create(Cvec, matrix_struct)
217 :
218 12 : NULLIFY (matrix_struct_tmp)
219 : CALL cp_fm_struct_create(matrix_struct_tmp, nrow_global=nactive, &
220 12 : ncol_global=nactive, template_fmstruct=matrix_struct)
221 12 : CALL cp_fm_create(CSXvec, matrix_struct_tmp)
222 12 : CALL cp_fm_struct_release(fmstruct=matrix_struct_tmp)
223 :
224 : CALL parallel_gemm('T', 'N', nactive, nactive, nao, 1.0_dp, &
225 12 : mos_occ, S_evects, 0.0_dp, CSXvec)
226 12 : CALL cp_fm_to_fm(mos_occ, Cvec)
227 :
228 12 : CALL cp_fm_column_scale(Cvec, fermia)
229 : CALL parallel_gemm('N', 'N', nao, nactive, nactive, 1.0_dp, &
230 12 : Cvec, CSXvec, 0.0_dp, CCSXvec)
231 :
232 : ! alpha S C C^T S X
233 : CALL cp_dbcsr_sm_fm_multiply(matrix_s, CCSXvec, &
234 12 : SCCSXvec, ncol=nactive, alpha=1.0_dp, beta=0.0_dp)
235 12 : CALL cp_fm_scale_and_add(1.0_dp, Aop_evects, 1.0_dp, SCCSXvec)
236 :
237 12 : CALL cp_fm_release(SCCSXvec)
238 12 : CALL cp_fm_release(CCSXvec)
239 12 : CALL cp_fm_release(CSXvec)
240 12 : CALL cp_fm_release(Cvec)
241 :
242 12 : CALL timestop(handle)
243 12 : END SUBROUTINE add_smearing_aterm
244 : ! **************************************************************************************************
245 : !> \brief ...
246 : !> \param qs_env ...
247 : !> \param gs_mos ...
248 : !> \param evals ...
249 : ! **************************************************************************************************
250 14 : SUBROUTINE compute_fermib(qs_env, gs_mos, evals)
251 :
252 : TYPE(qs_environment_type), POINTER :: qs_env
253 : TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
254 : INTENT(IN) :: gs_mos
255 : REAL(kind=dp), INTENT(in) :: evals
256 :
257 : CHARACTER(len=*), PARAMETER :: routineN = 'compute_fermib'
258 :
259 : INTEGER :: handle, iocc, iounit, ispin, jocc, &
260 : nactive, nspins
261 : REAL(KIND=dp) :: dummykTS, interocc, nelec
262 14 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: occuptmp
263 14 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: occup_im
264 14 : REAL(kind=dp), DIMENSION(:), POINTER :: fermia, mo_evals, occup
265 14 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: fermib
266 : TYPE(cp_logger_type), POINTER :: logger
267 : TYPE(dft_control_type), POINTER :: dft_control
268 14 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
269 : TYPE(scf_control_type), POINTER :: scf_control
270 : TYPE(smear_type), POINTER :: smear
271 : TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
272 :
273 14 : CALL timeset(routineN, handle)
274 :
275 14 : NULLIFY (logger)
276 14 : logger => cp_get_default_logger()
277 14 : iounit = cp_logger_get_default_io_unit(logger)
278 :
279 14 : NULLIFY (mos, scf_control)
280 14 : CALL get_qs_env(qs_env, mos=mos, scf_control=scf_control)
281 14 : NULLIFY (smear)
282 14 : IF (ASSOCIATED(qs_env%scf_control%smear)) THEN
283 : smear => qs_env%scf_control%smear
284 : ELSE
285 0 : CPABORT("Smeared input section no longer associated.")
286 : END IF
287 :
288 14 : NULLIFY (dft_control, tddfpt_control)
289 14 : CALL get_qs_env(qs_env, dft_control=dft_control)
290 14 : tddfpt_control => dft_control%tddfpt2_control
291 :
292 14 : NULLIFY (fermib, fermia)
293 14 : nspins = SIZE(gs_mos)
294 :
295 28 : DO ispin = 1, nspins
296 :
297 14 : fermib => dft_control%tddfpt2_control%smeared_occup(ispin)%fermib
298 14 : fermia => dft_control%tddfpt2_control%smeared_occup(ispin)%fermia
299 294 : fermib = 0.0_dp
300 :
301 : ! get theta_Fi
302 14 : NULLIFY (mo_evals, occup)
303 14 : CALL get_mo_set(mos(ispin), eigenvalues=mo_evals, occupation_numbers=occup)
304 14 : CALL cp_fm_get_info(gs_mos(ispin)%mos_occ, ncol_global=nactive)
305 :
306 : ! compute theta_im
307 : ! SmearOcc writes its output; keep the ground-state occupations unchanged.
308 84 : ALLOCATE (occuptmp(SIZE(mo_evals)), occup_im(nactive, nactive))
309 :
310 70 : DO iocc = 1, nactive
311 56 : IF (smear%method == smear_fermi_dirac) THEN
312 : ! Different prefactor in comparison to Octopus !
313 : CALL SmearOcc(occuptmp, nelec, dummykTS, mos(ispin)%eigenvalues, mos(ispin)%eigenvalues(iocc), &
314 56 : smear%electronic_temperature, mos(ispin)%maxocc, smear_fermi_dirac)
315 : ELSE
316 0 : CPABORT("TDDFT with smearing only works with Fermi-Dirac distribution.")
317 : END IF
318 294 : occup_im(iocc, :) = occuptmp(:nactive)
319 : END DO
320 :
321 : ! compute fermib
322 70 : DO iocc = 1, nactive
323 294 : DO jocc = 1, nactive
324 224 : interocc = (occup(iocc) - occup(jocc))/(mo_evals(iocc) - mo_evals(jocc) - evals)
325 : fermib(iocc, jocc) = fermib(iocc, jocc) + occup(iocc)*occup_im(iocc, jocc) &
326 : + occup(jocc)*occup_im(jocc, iocc) &
327 280 : + fermia(jocc)*interocc*occup_im(jocc, iocc)
328 : END DO
329 : END DO
330 :
331 : IF (debug_this_module .AND. (iounit > 0)) THEN
332 : DO iocc = 1, nactive
333 : DO jocc = 1, nactive
334 : WRITE (iounit, '(A,F14.5)') "Fermi smearing parameter beta,", fermib(iocc, jocc)
335 : END DO
336 : END DO
337 : END IF
338 :
339 42 : DEALLOCATE (occuptmp, occup_im)
340 :
341 : END DO ! ispin
342 :
343 14 : CALL timestop(handle)
344 28 : END SUBROUTINE compute_fermib
345 : ! **************************************************************************************************
346 : !> \brief ...
347 : !> \param qs_env ...
348 : !> \param gs_mos ...
349 : ! **************************************************************************************************
350 2 : SUBROUTINE allocate_fermi_params(qs_env, gs_mos)
351 :
352 : TYPE(qs_environment_type), POINTER :: qs_env
353 : TYPE(tddfpt_ground_state_mos), DIMENSION(:), &
354 : INTENT(IN), POINTER :: gs_mos
355 :
356 : CHARACTER(len=*), PARAMETER :: routineN = 'allocate_fermi_params'
357 :
358 : INTEGER :: handle, ispin, nocc, nspins
359 : TYPE(dft_control_type), POINTER :: dft_control
360 2 : TYPE(smeared_type), DIMENSION(:), POINTER :: smeared_occup
361 : TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
362 :
363 2 : CALL timeset(routineN, handle)
364 :
365 2 : NULLIFY (dft_control, tddfpt_control)
366 2 : CALL get_qs_env(qs_env, dft_control=dft_control)
367 2 : tddfpt_control => dft_control%tddfpt2_control
368 :
369 : NULLIFY (smeared_occup)
370 2 : smeared_occup => dft_control%tddfpt2_control%smeared_occup
371 2 : nspins = SIZE(gs_mos)
372 8 : ALLOCATE (smeared_occup(nspins))
373 :
374 4 : DO ispin = 1, nspins
375 2 : CALL cp_fm_get_info(gs_mos(ispin)%mos_occ, ncol_global=nocc)
376 6 : ALLOCATE (smeared_occup(ispin)%fermia(nocc))
377 12 : ALLOCATE (smeared_occup(ispin)%fermib(nocc, nocc))
378 : END DO
379 2 : dft_control%tddfpt2_control%smeared_occup => smeared_occup
380 :
381 2 : CALL timestop(handle)
382 2 : END SUBROUTINE allocate_fermi_params
383 : ! **************************************************************************************************
384 : !> \brief ...
385 : !> \param smeared_occup ...
386 : ! **************************************************************************************************
387 2 : SUBROUTINE deallocate_fermi_params(smeared_occup)
388 :
389 : TYPE(smeared_type), DIMENSION(:), POINTER :: smeared_occup
390 :
391 : INTEGER :: ispin
392 :
393 2 : IF (ASSOCIATED(smeared_occup)) THEN
394 4 : DO ispin = 1, SIZE(smeared_occup)
395 4 : IF (ASSOCIATED(smeared_occup(ispin)%fermia)) THEN
396 2 : DEALLOCATE (smeared_occup(ispin)%fermia)
397 2 : DEALLOCATE (smeared_occup(ispin)%fermib)
398 2 : NULLIFY (smeared_occup(ispin)%fermia, smeared_occup(ispin)%fermib)
399 : END IF
400 : END DO
401 2 : DEALLOCATE (smeared_occup)
402 : NULLIFY (smeared_occup)
403 : END IF
404 :
405 2 : END SUBROUTINE deallocate_fermi_params
406 : ! **************************************************************************************************
407 : !> \brief ...
408 : !> \param evects ...
409 : !> \param qs_env ...
410 : !> \param mos_occ ...
411 : !> \param S_C0 ...
412 : ! **************************************************************************************************
413 14 : SUBROUTINE orthogonalize_smeared_occupation(evects, qs_env, mos_occ, S_C0)
414 :
415 : TYPE(cp_fm_type), DIMENSION(:), INTENT(in) :: evects
416 : TYPE(qs_environment_type), POINTER :: qs_env
417 : TYPE(cp_fm_type), DIMENSION(:), INTENT(in) :: mos_occ, S_C0
418 :
419 : CHARACTER(LEN=*), PARAMETER :: routineN = 'orthogonalize_smeared_occupation'
420 :
421 : INTEGER :: handle, iocc, ispin, nactive, nao, nspins
422 14 : REAL(kind=dp), DIMENSION(:), POINTER :: occup
423 14 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: fermib
424 : TYPE(cp_blacs_env_type), POINTER :: blacs_env_global
425 : TYPE(cp_fm_struct_type), POINTER :: matrix_struct
426 : TYPE(cp_fm_type) :: betaSCC, Cvec, evortho
427 : TYPE(dft_control_type), POINTER :: dft_control
428 14 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
429 : TYPE(mp_para_env_type), POINTER :: para_env
430 : TYPE(tddfpt2_control_type), POINTER :: tddfpt_control
431 :
432 14 : CALL timeset(routineN, handle)
433 :
434 14 : NULLIFY (mos)
435 14 : CALL get_qs_env(qs_env, mos=mos)
436 14 : NULLIFY (dft_control, tddfpt_control)
437 14 : CALL get_qs_env(qs_env, dft_control=dft_control)
438 14 : tddfpt_control => dft_control%tddfpt2_control
439 :
440 14 : CALL cp_fm_get_info(matrix=evects(1), nrow_global=nao)
441 :
442 14 : nspins = SIZE(evects)
443 14 : NULLIFY (para_env)
444 14 : CALL cp_fm_get_info(evects(1), para_env=para_env, context=blacs_env_global)
445 :
446 14 : NULLIFY (matrix_struct)
447 14 : CALL cp_fm_struct_create(matrix_struct, nrow_global=nao, ncol_global=nao, context=blacs_env_global)
448 14 : CALL cp_fm_create(betaSCC, matrix_struct)
449 14 : CALL cp_fm_struct_release(fmstruct=matrix_struct)
450 :
451 28 : DO ispin = 1, nspins
452 14 : CALL cp_fm_get_info(matrix=evects(ispin), matrix_struct=matrix_struct, ncol_global=nactive)
453 14 : CALL cp_fm_create(evortho, matrix_struct)
454 14 : NULLIFY (matrix_struct)
455 14 : CALL cp_fm_get_info(matrix=mos_occ(ispin), matrix_struct=matrix_struct)
456 14 : CALL cp_fm_create(Cvec, matrix_struct)
457 :
458 14 : NULLIFY (occup)
459 14 : CALL get_mo_set(mos(ispin), occupation_numbers=occup)
460 :
461 14 : NULLIFY (fermib)
462 14 : IF (.NOT. ASSOCIATED(dft_control%tddfpt2_control%smeared_occup)) THEN
463 0 : CPABORT("Smeared occupation intermediates not associated.")
464 : END IF
465 14 : fermib => dft_control%tddfpt2_control%smeared_occup(ispin)%fermib
466 :
467 70 : DO iocc = 1, nactive
468 56 : CALL cp_fm_copy_general(mos_occ(ispin), Cvec, para_env)
469 56 : CALL cp_fm_column_scale(Cvec, fermib(iocc, :))
470 :
471 56 : CALL parallel_gemm('N', 'T', nao, nao, nactive, 1.0_dp, Cvec, S_C0(ispin), 0.0_dp, betaSCC)
472 :
473 : ! Apply the occupied-space correction directly to column iocc.
474 : CALL parallel_gemm('N', 'N', nao, 1, nao, 1.0_dp, betaSCC, &
475 70 : evects(ispin), 0.0_dp, evortho, b_first_col=iocc, c_first_col=iocc)
476 : END DO ! iocc
477 14 : CALL cp_fm_column_scale(evects(ispin), occup)
478 14 : CALL cp_fm_scale_and_add(1.0_dp, evects(ispin), -1.0_dp, evortho)
479 14 : CALL cp_fm_release(Cvec)
480 56 : CALL cp_fm_release(evortho)
481 : END DO ! nspins
482 :
483 14 : CALL cp_fm_release(betaSCC)
484 :
485 14 : CALL timestop(handle)
486 14 : END SUBROUTINE orthogonalize_smeared_occupation
487 :
488 : END MODULE qs_tddfpt2_smearing_methods
|
