(git:ed6f26b)
Loading...
Searching...
No Matches
qs_linres_methods.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief localize wavefunctions
10!> linear response scf
11!> \par History
12!> created 07-2005 [MI]
13!> \author MI
14! **************************************************************************************************
17 USE cp_dbcsr_api, ONLY: dbcsr_copy,&
19 dbcsr_set,&
24 USE cp_files, ONLY: close_file,&
31 USE cp_fm_types, ONLY: cp_fm_create,&
41 USE cp_output_handling, ONLY: cp_p_file,&
46 USE input_constants, ONLY: do_loc_none,&
54 USE kinds, ONLY: default_path_length,&
56 dp
57 USE machine, ONLY: m_flush,&
69 USE qs_loc_main, ONLY: qs_loc_driver
70 USE qs_loc_types, ONLY: get_qs_loc_env,&
77 USE qs_mo_types, ONLY: get_mo_set,&
83 USE qs_rho_types, ONLY: qs_rho_type
84 USE string_utilities, ONLY: xstring
85#include "./base/base_uses.f90"
86
87 IMPLICIT NONE
88
89 PRIVATE
90
91 ! *** Public subroutines ***
94 PUBLIC :: build_dm_response
95
96 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_linres_methods'
97
98! **************************************************************************************************
99
100CONTAINS
101
102! **************************************************************************************************
103!> \brief Find the centers and spreads of the wfn,
104!> if required apply a localization algorithm
105!> \param qs_env ...
106!> \param linres_control ...
107!> \param nspins ...
108!> \param centers_only ...
109!> \par History
110!> 07.2005 created [MI]
111!> \author MI
112! **************************************************************************************************
113 SUBROUTINE linres_localize(qs_env, linres_control, nspins, centers_only)
114
115 TYPE(qs_environment_type), POINTER :: qs_env
116 TYPE(linres_control_type), POINTER :: linres_control
117 INTEGER, INTENT(IN) :: nspins
118 LOGICAL, INTENT(IN), OPTIONAL :: centers_only
119
120 INTEGER :: iounit, ispin, istate, nmoloc(2)
121 LOGICAL :: my_centers_only
122 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: mos_localized
123 TYPE(cp_fm_type), POINTER :: mo_coeff
124 TYPE(cp_logger_type), POINTER :: logger
125 TYPE(localized_wfn_control_type), POINTER :: localized_wfn_control
126 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
127 TYPE(qs_loc_env_type), POINTER :: qs_loc_env
128 TYPE(section_vals_type), POINTER :: loc_print_section, loc_section, &
129 lr_section
130
131 NULLIFY (logger, lr_section, loc_section, loc_print_section, localized_wfn_control)
132 logger => cp_get_default_logger()
133 lr_section => section_vals_get_subs_vals(qs_env%input, "PROPERTIES%LINRES")
134 loc_section => section_vals_get_subs_vals(lr_section, "LOCALIZE")
135 loc_print_section => section_vals_get_subs_vals(lr_section, "LOCALIZE%PRINT")
136 iounit = cp_print_key_unit_nr(logger, lr_section, "PRINT%PROGRAM_RUN_INFO", &
137 extension=".linresLog")
138 my_centers_only = .false.
139 IF (PRESENT(centers_only)) my_centers_only = centers_only
140
141 NULLIFY (mos, mo_coeff, qs_loc_env)
142 CALL get_qs_env(qs_env=qs_env, mos=mos)
143 ALLOCATE (qs_loc_env)
144 CALL qs_loc_env_create(qs_loc_env)
145 linres_control%qs_loc_env => qs_loc_env
146 CALL qs_loc_control_init(qs_loc_env, loc_section, do_homo=.true.)
147 CALL get_qs_loc_env(qs_loc_env, localized_wfn_control=localized_wfn_control)
148
149 ALLOCATE (mos_localized(nspins))
150 DO ispin = 1, nspins
151 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff)
152 CALL cp_fm_create(mos_localized(ispin), mo_coeff%matrix_struct)
153 CALL cp_fm_to_fm(mo_coeff, mos_localized(ispin))
154 END DO
155
156 nmoloc(1:2) = 0
157 IF (my_centers_only) THEN
158 localized_wfn_control%set_of_states = state_loc_all
159 localized_wfn_control%localization_method = do_loc_none
160 localized_wfn_control%operator_type = op_loc_berry
161 END IF
162
163 CALL qs_loc_init(qs_env, qs_loc_env, loc_section, mos_localized=mos_localized, &
164 do_homo=.true.)
165
166 ! The orbital centers are stored in linres_control%localized_wfn_control
167 DO ispin = 1, nspins
168 CALL qs_loc_driver(qs_env, qs_loc_env, loc_print_section, myspin=ispin, &
169 ext_mo_coeff=mos_localized(ispin))
170 CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff)
171 CALL cp_fm_to_fm(mos_localized(ispin), mo_coeff)
172 END DO
173
174 CALL loc_write_restart(qs_loc_env, loc_print_section, mos, &
175 mos_localized, do_homo=.true.)
176 CALL cp_fm_release(mos_localized)
177
178 ! Write Centers and Spreads on std out
179 IF (iounit > 0) THEN
180 DO ispin = 1, nspins
181 WRITE (iounit, "(/,T2,A,I2)") &
182 "WANNIER CENTERS for spin ", ispin
183 WRITE (iounit, "(/,T18,A,3X,A)") &
184 "--------------- Centers --------------- ", &
185 "--- Spreads ---"
186 DO istate = 1, SIZE(localized_wfn_control%centers_set(ispin)%array, 2)
187 WRITE (iounit, "(T5,A6,I6,2X,3f12.6,5X,f12.6)") &
188 'state ', istate, localized_wfn_control%centers_set(ispin)%array(1:3, istate), &
189 localized_wfn_control%centers_set(ispin)%array(4, istate)
190 END DO
191 END DO
192 CALL m_flush(iounit)
193 END IF
194
195 END SUBROUTINE linres_localize
196
197! **************************************************************************************************
198!> \brief scf loop to optimize the first order wavefunctions (psi1)
199!> given a perturbation as an operator applied to the ground
200!> state orbitals (h1_psi0)
201!> psi1 is defined wrt psi0_order (can be a subset of the occupied space)
202!> The reference ground state is defined through qs_env (density and ground state MOs)
203!> psi1 is orthogonal to the occupied orbitals in the ground state MO set (qs_env%mos)
204!> \param p_env ...
205!> \param qs_env ...
206!> \param psi1 ...
207!> \param h1_psi0 ...
208!> \param psi0_order ...
209!> \param iounit ...
210!> \param should_stop ...
211!> \par History
212!> 07.2005 created [MI]
213!> \author MI
214! **************************************************************************************************
215 SUBROUTINE linres_solver(p_env, qs_env, psi1, h1_psi0, psi0_order, iounit, should_stop)
216 TYPE(qs_p_env_type) :: p_env
217 TYPE(qs_environment_type), POINTER :: qs_env
218 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: psi1, h1_psi0, psi0_order
219 INTEGER, INTENT(IN) :: iounit
220 LOGICAL, INTENT(OUT) :: should_stop
221
222 CHARACTER(LEN=*), PARAMETER :: routinen = 'linres_solver'
223
224 INTEGER :: handle, ispin, iter, maxnmo, nao, ncol, &
225 nmo, nocc, nspins
226 LOGICAL :: restart
227 REAL(dp) :: alpha, beta, norm_res, t1, t2
228 REAL(dp), DIMENSION(:), POINTER :: tr_pap, tr_rz0, tr_rz00, tr_rz1
229 TYPE(cp_fm_struct_type), POINTER :: tmp_fm_struct
230 TYPE(cp_fm_type) :: buf
231 TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:) :: ap, chc, mo_coeff_array, p, r, z
232 TYPE(cp_fm_type), DIMENSION(:), POINTER :: sc
233 TYPE(cp_fm_type), POINTER :: mo_coeff
234 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_s, matrix_t
235 TYPE(dbcsr_type), POINTER :: matrix_x
236 TYPE(dft_control_type), POINTER :: dft_control
237 TYPE(linres_control_type), POINTER :: linres_control
238 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
239 TYPE(mp_para_env_type), POINTER :: para_env
240
241 CALL timeset(routinen, handle)
242
243 NULLIFY (dft_control, linres_control, matrix_s, matrix_t, matrix_ks, para_env)
244 NULLIFY (mos, tmp_fm_struct, mo_coeff)
245
246 t1 = m_walltime()
247
248 CALL get_qs_env(qs_env=qs_env, &
249 matrix_ks=matrix_ks, &
250 matrix_s=matrix_s, &
251 kinetic=matrix_t, &
252 dft_control=dft_control, &
253 linres_control=linres_control, &
254 para_env=para_env, &
255 mos=mos)
256
257 nspins = dft_control%nspins
258 CALL cp_fm_get_info(psi1(1), nrow_global=nao)
259 maxnmo = 0
260 DO ispin = 1, nspins
261 CALL cp_fm_get_info(psi1(ispin), ncol_global=ncol)
262 maxnmo = max(maxnmo, ncol)
263 END DO
264 !
265 CALL check_p_env_init(p_env, linres_control, nspins)
266 !
267 ! allocate the vectors
268 ALLOCATE (tr_pap(nspins), tr_rz0(nspins), tr_rz00(nspins), tr_rz1(nspins), &
269 r(nspins), p(nspins), z(nspins), ap(nspins))
270 !
271 DO ispin = 1, nspins
272 CALL cp_fm_create(r(ispin), psi1(ispin)%matrix_struct)
273 CALL cp_fm_create(p(ispin), psi1(ispin)%matrix_struct)
274 CALL cp_fm_create(z(ispin), psi1(ispin)%matrix_struct)
275 CALL cp_fm_create(ap(ispin), psi1(ispin)%matrix_struct)
276 END DO
277 !
278 ! build C0 occupied vectors and S*C0 matrix
279 ALLOCATE (sc(nspins), mo_coeff_array(nspins))
280 DO ispin = 1, nspins
281 CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, homo=nocc)
282 NULLIFY (tmp_fm_struct)
283 CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nao, &
284 ncol_global=nocc, para_env=para_env, &
285 context=mo_coeff%matrix_struct%context)
286 CALL cp_fm_create(mo_coeff_array(ispin), tmp_fm_struct)
287 CALL cp_fm_to_fm(mo_coeff, mo_coeff_array(ispin), nocc)
288 CALL cp_fm_create(sc(ispin), tmp_fm_struct)
289 CALL cp_fm_struct_release(tmp_fm_struct)
290 END DO
291 !
292 ! Allocate C0_order'*H*C0_order
293 ALLOCATE (chc(nspins))
294 DO ispin = 1, nspins
295 CALL cp_fm_get_info(psi1(ispin), ncol_global=nmo)
296 NULLIFY (tmp_fm_struct)
297 CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nmo, &
298 ncol_global=nmo, para_env=para_env, &
299 context=mo_coeff%matrix_struct%context)
300 CALL cp_fm_create(chc(ispin), tmp_fm_struct)
301 CALL cp_fm_struct_release(tmp_fm_struct)
302 END DO
303 !
304 DO ispin = 1, nspins
305 !
306 ! C0_order' * H * C0_order
307 associate(mo_coeff => psi0_order(ispin))
308 CALL cp_fm_create(buf, mo_coeff%matrix_struct)
309 CALL cp_fm_get_info(mo_coeff, ncol_global=ncol)
310 CALL cp_dbcsr_sm_fm_multiply(matrix_ks(ispin)%matrix, mo_coeff, buf, ncol)
311 CALL parallel_gemm('T', 'N', ncol, ncol, nao, -1.0_dp, mo_coeff, buf, 0.0_dp, chc(ispin))
312 CALL cp_fm_release(buf)
313 END associate
314 !
315 ! S * C0
316 CALL cp_fm_get_info(mo_coeff_array(ispin), ncol_global=ncol)
317 CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, mo_coeff_array(ispin), sc(ispin), ncol)
318 END DO
319 !
320 ! header
321 IF (iounit > 0) THEN
322 WRITE (iounit, "(/,T3,A,T16,A,T25,A,T38,A,T52,A,T72,A,/,T3,A)") &
323 "Iteration", "Method", "Restart", "Stepsize", "Convergence", "Time", &
324 repeat("-", 78)
325 END IF
326 !
327 ! orthogonalize x with respect to the psi0
328 CALL preortho(psi1, mo_coeff_array, sc)
329 !
330 ! build the preconditioner
331 IF (linres_control%preconditioner_type /= ot_precond_none) THEN
332 IF (p_env%new_preconditioner) THEN
333 DO ispin = 1, nspins
334 IF (ASSOCIATED(matrix_t)) THEN
335 CALL make_preconditioner(p_env%preconditioner(ispin), &
336 linres_control%preconditioner_type, ot_precond_solver_default, &
337 matrix_ks(ispin)%matrix, matrix_s(1)%matrix, matrix_t(1)%matrix, &
338 mos(ispin), linres_control%energy_gap)
339 ELSE
340 NULLIFY (matrix_x)
341 CALL make_preconditioner(p_env%preconditioner(ispin), &
342 linres_control%preconditioner_type, ot_precond_solver_default, &
343 matrix_ks(ispin)%matrix, matrix_s(1)%matrix, matrix_x, &
344 mos(ispin), linres_control%energy_gap)
345 END IF
346 END DO
347 p_env%new_preconditioner = .false.
348 END IF
349 END IF
350 !
351 ! initialization of the linear solver
352 !
353 ! A * x0
354 CALL apply_op(qs_env, p_env, psi0_order, psi1, ap, chc)
355 !
356 !
357 ! r_0 = b - Ax0
358 DO ispin = 1, nspins
359 CALL cp_fm_to_fm(h1_psi0(ispin), r(ispin))
360 CALL cp_fm_scale_and_add(-1.0_dp, r(ispin), -1.0_dp, ap(ispin))
361 END DO
362 !
363 ! proj r
364 CALL postortho(r, mo_coeff_array, sc)
365 !
366 ! preconditioner
367 linres_control%flag = ""
368 IF (linres_control%preconditioner_type .EQ. ot_precond_none) THEN
369 !
370 ! z_0 = r_0
371 DO ispin = 1, nspins
372 CALL cp_fm_to_fm(r(ispin), z(ispin))
373 END DO
374 linres_control%flag = "CG"
375 ELSE
376 !
377 ! z_0 = M * r_0
378 DO ispin = 1, nspins
379 CALL apply_preconditioner(p_env%preconditioner(ispin), r(ispin), &
380 z(ispin))
381 END DO
382 linres_control%flag = "PCG"
383 END IF
384 !
385 DO ispin = 1, nspins
386 !
387 ! p_0 = z_0
388 CALL cp_fm_to_fm(z(ispin), p(ispin))
389 !
390 ! trace(r_0 * z_0)
391 CALL cp_fm_trace(r(ispin), z(ispin), tr_rz0(ispin))
392 END DO
393 IF (sum(tr_rz0) < 0.0_dp) cpabort("tr(r_j*z_j) < 0")
394 norm_res = abs(sum(tr_rz0))/sqrt(real(nspins*nao*maxnmo, dp))
395 !
396 alpha = 0.0_dp
397 restart = .false.
398 should_stop = .false.
399 iteration: DO iter = 1, linres_control%max_iter
400 !
401 ! check convergence
402 linres_control%converged = .false.
403 IF (norm_res .LT. linres_control%eps) THEN
404 linres_control%converged = .true.
405 END IF
406 !
407 t2 = m_walltime()
408 IF (iter .EQ. 1 .OR. mod(iter, 1) .EQ. 0 .OR. linres_control%converged &
409 .OR. restart .OR. should_stop) THEN
410 IF (iounit > 0) THEN
411 WRITE (iounit, "(T5,I5,T18,A3,T28,L1,T38,1E8.2,T48,F16.10,T68,F8.2)") &
412 iter, linres_control%flag, restart, alpha, norm_res, t2 - t1
413 CALL m_flush(iounit)
414 END IF
415 END IF
416 !
417 IF (linres_control%converged) THEN
418 IF (iounit > 0) THEN
419 WRITE (iounit, "(T3,A,I4,A)") "The linear solver converged in ", iter, " iterations."
420 CALL m_flush(iounit)
421 END IF
422 EXIT iteration
423 ELSE IF (should_stop) THEN
424 IF (iounit > 0) THEN
425 WRITE (iounit, "(T3,A,I4,A)") "The linear solver did NOT converge! External stop"
426 CALL m_flush(iounit)
427 END IF
428 EXIT iteration
429 END IF
430 !
431 ! Max number of iteration reached
432 IF (iter == linres_control%max_iter) THEN
433 IF (iounit > 0) THEN
434 CALL cp_warn(__location__, &
435 "The linear solver didn't converge! Maximum number of iterations reached.")
436 CALL m_flush(iounit)
437 END IF
438 linres_control%converged = .false.
439 END IF
440 !
441 ! Apply the operators that do not depend on the perturbation
442 CALL apply_op(qs_env, p_env, psi0_order, p, ap, chc)
443 !
444 ! proj Ap onto the virtual subspace
445 CALL postortho(ap, mo_coeff_array, sc)
446 !
447 DO ispin = 1, nspins
448 !
449 ! tr(Ap_j*p_j)
450 CALL cp_fm_trace(ap(ispin), p(ispin), tr_pap(ispin))
451 END DO
452 !
453 ! alpha = tr(r_j*z_j) / tr(Ap_j*p_j)
454 IF (sum(tr_pap) < 1.0e-10_dp) THEN
455 alpha = 1.0_dp
456 ELSE
457 alpha = sum(tr_rz0)/sum(tr_pap)
458 END IF
459 DO ispin = 1, nspins
460 !
461 ! x_j+1 = x_j + alpha * p_j
462 CALL cp_fm_scale_and_add(1.0_dp, psi1(ispin), alpha, p(ispin))
463 END DO
464 !
465 ! need to recompute the residue
466 restart = .false.
467 IF (mod(iter, linres_control%restart_every) .EQ. 0) THEN
468 !
469 ! r_j+1 = b - A * x_j+1
470 CALL apply_op(qs_env, p_env, psi0_order, psi1, ap, chc)
471 !
472 DO ispin = 1, nspins
473 CALL cp_fm_to_fm(h1_psi0(ispin), r(ispin))
474 CALL cp_fm_scale_and_add(-1.0_dp, r(ispin), -1.0_dp, ap(ispin))
475 END DO
476 CALL postortho(r, mo_coeff_array, sc)
477 !
478 restart = .true.
479 ELSE
480 ! proj Ap onto the virtual subspace
481 CALL postortho(ap, mo_coeff_array, sc)
482 !
483 ! r_j+1 = r_j - alpha * Ap_j
484 DO ispin = 1, nspins
485 CALL cp_fm_scale_and_add(1.0_dp, r(ispin), -alpha, ap(ispin))
486 END DO
487 restart = .false.
488 END IF
489 !
490 ! preconditioner
491 linres_control%flag = ""
492 IF (linres_control%preconditioner_type .EQ. ot_precond_none) THEN
493 !
494 ! z_j+1 = r_j+1
495 DO ispin = 1, nspins
496 CALL cp_fm_to_fm(r(ispin), z(ispin))
497 END DO
498 linres_control%flag = "CG"
499 ELSE
500 !
501 ! z_j+1 = M * r_j+1
502 DO ispin = 1, nspins
503 CALL apply_preconditioner(p_env%preconditioner(ispin), r(ispin), &
504 z(ispin))
505 END DO
506 linres_control%flag = "PCG"
507 END IF
508 !
509 DO ispin = 1, nspins
510 !
511 ! tr(r_j+1*z_j+1)
512 CALL cp_fm_trace(r(ispin), z(ispin), tr_rz1(ispin))
513 END DO
514 IF (sum(tr_rz1) < 0.0_dp) cpabort("tr(r_j+1*z_j+1) < 0")
515 norm_res = sum(tr_rz1)/sqrt(real(nspins*nao*maxnmo, dp))
516 !
517 ! beta = tr(r_j+1*z_j+1) / tr(r_j*z_j)
518 IF (sum(tr_rz0) < 1.0e-10_dp) THEN
519 beta = 0.0_dp
520 ELSE
521 beta = sum(tr_rz1)/sum(tr_rz0)
522 END IF
523 DO ispin = 1, nspins
524 !
525 ! p_j+1 = z_j+1 + beta * p_j
526 CALL cp_fm_scale_and_add(beta, p(ispin), 1.0_dp, z(ispin))
527 tr_rz00(ispin) = tr_rz0(ispin)
528 tr_rz0(ispin) = tr_rz1(ispin)
529 END DO
530 !
531 ! Can we exit the SCF loop?
532 CALL external_control(should_stop, "LINRES", target_time=qs_env%target_time, &
533 start_time=qs_env%start_time)
534
535 END DO iteration
536 !
537 ! proj psi1
538 CALL preortho(psi1, mo_coeff_array, sc)
539 !
540 !
541 ! clean up
542 CALL cp_fm_release(r)
543 CALL cp_fm_release(p)
544 CALL cp_fm_release(z)
545 CALL cp_fm_release(ap)
546 !
547 CALL cp_fm_release(mo_coeff_array)
548 CALL cp_fm_release(sc)
549 CALL cp_fm_release(chc)
550 !
551 DEALLOCATE (tr_pap, tr_rz0, tr_rz00, tr_rz1)
552 !
553 CALL timestop(handle)
554 !
555 END SUBROUTINE linres_solver
556
557! **************************************************************************************************
558!> \brief ...
559!> \param qs_env ...
560!> \param p_env ...
561!> \param c0 ...
562!> \param v ...
563!> \param Av ...
564!> \param chc ...
565! **************************************************************************************************
566 SUBROUTINE apply_op(qs_env, p_env, c0, v, Av, chc)
567 !
568 TYPE(qs_environment_type), INTENT(IN), POINTER :: qs_env
569 TYPE(qs_p_env_type) :: p_env
570 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: c0, v
571 TYPE(cp_fm_type), DIMENSION(:), INTENT(INOUT) :: av
572 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: chc
573
574 CHARACTER(LEN=*), PARAMETER :: routinen = 'apply_op'
575
576 INTEGER :: handle, ispin, nc1, nc2, nc3, nc4, nr1, &
577 nr2, nr3, nr4, nspins
578 REAL(dp) :: chksum
579 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_s
580 TYPE(dft_control_type), POINTER :: dft_control
581 TYPE(linres_control_type), POINTER :: linres_control
582 TYPE(qs_rho_type), POINTER :: rho
583
584 CALL timeset(routinen, handle)
585
586 NULLIFY (dft_control, matrix_ks, matrix_s, linres_control)
587 CALL get_qs_env(qs_env=qs_env, &
588 matrix_ks=matrix_ks, &
589 matrix_s=matrix_s, &
590 dft_control=dft_control, &
591 linres_control=linres_control)
592
593 nspins = dft_control%nspins
594
595 DO ispin = 1, nspins
596 !c0, v, Av, chc
597 CALL cp_fm_get_info(c0(ispin), ncol_global=nc1, nrow_global=nr1)
598 CALL cp_fm_get_info(v(ispin), ncol_global=nc2, nrow_global=nr2)
599 CALL cp_fm_get_info(av(ispin), ncol_global=nc3, nrow_global=nr3)
600 CALL cp_fm_get_info(chc(ispin), ncol_global=nc4, nrow_global=nr4)
601 IF (.NOT. (nc1 == nc2 .AND. nr1 == nr2 .AND. nc1 == nc3 .AND. nr1 == nr3 &
602 .AND. nc4 == nr4 .AND. nc1 <= nc4)) THEN
603 CALL cp_abort(__location__, &
604 "Number of vectors inconsistent or CHC matrix too small")
605 END IF
606 END DO
607
608 ! apply the uncoupled operator
609 DO ispin = 1, nspins
610 CALL apply_op_1(v(ispin), av(ispin), matrix_ks(ispin)%matrix, &
611 matrix_s(1)%matrix, chc(ispin))
612 END DO
613
614 IF (linres_control%do_kernel) THEN
615
616 ! build DM, refill p1, build_dm_response keeps sparse structure
617 DO ispin = 1, nspins
618 CALL dbcsr_copy(p_env%p1(ispin)%matrix, matrix_s(1)%matrix)
619 END DO
620 CALL build_dm_response(c0, v, p_env%p1)
621
622 chksum = 0.0_dp
623 DO ispin = 1, nspins
624 chksum = chksum + dbcsr_checksum(p_env%p1(ispin)%matrix)
625 END DO
626
627 ! skip the kernel if the DM is very small
628 IF (chksum .GT. 1.0e-14_dp) THEN
629
630 CALL p_env_check_i_alloc(p_env, qs_env)
631
632 CALL p_env_update_rho(p_env, qs_env)
633
634 CALL get_qs_env(qs_env, rho=rho) ! that could be called before
635 CALL qs_rho_update_rho(rho, qs_env=qs_env) ! that could be called before
636 IF (dft_control%qs_control%gapw) THEN
637 CALL prepare_gapw_den(qs_env)
638 ELSEIF (dft_control%qs_control%gapw_xc) THEN
639 CALL prepare_gapw_den(qs_env, do_rho0=.false.)
640 END IF
641
642 DO ispin = 1, nspins
643 CALL dbcsr_set(p_env%kpp1(ispin)%matrix, 0.0_dp)
644 IF (ASSOCIATED(p_env%kpp1_admm)) CALL dbcsr_set(p_env%kpp1_admm(ispin)%matrix, 0.0_dp)
645 END DO
646
647 CALL apply_op_2(qs_env, p_env, c0, av)
648
649 END IF
650
651 END IF
652
653 CALL timestop(handle)
654
655 END SUBROUTINE apply_op
656
657! **************************************************************************************************
658!> \brief ...
659!> \param v ...
660!> \param Av ...
661!> \param matrix_ks ...
662!> \param matrix_s ...
663!> \param chc ...
664! **************************************************************************************************
665 SUBROUTINE apply_op_1(v, Av, matrix_ks, matrix_s, chc)
666 !
667 TYPE(cp_fm_type), INTENT(IN) :: v
668 TYPE(cp_fm_type), INTENT(INOUT) :: av
669 TYPE(dbcsr_type), INTENT(IN) :: matrix_ks, matrix_s
670 TYPE(cp_fm_type), INTENT(IN) :: chc
671
672 CHARACTER(LEN=*), PARAMETER :: routinen = 'apply_op_1'
673
674 INTEGER :: handle, ncol, nrow
675 TYPE(cp_fm_type) :: buf
676
677 CALL timeset(routinen, handle)
678 !
679 CALL cp_fm_create(buf, v%matrix_struct)
680 !
681 CALL cp_fm_get_info(v, ncol_global=ncol, nrow_global=nrow)
682 ! H * v
683 CALL cp_dbcsr_sm_fm_multiply(matrix_ks, v, av, ncol)
684 ! v * e (chc already multiplied by -1)
685 CALL parallel_gemm('N', 'N', nrow, ncol, ncol, 1.0_dp, v, chc, 0.0_dp, buf)
686 ! S * ve
687 CALL cp_dbcsr_sm_fm_multiply(matrix_s, buf, av, ncol, alpha=1.0_dp, beta=1.0_dp)
688 !Results is H*C1 - S*<iHj>*C1
689 !
690 CALL cp_fm_release(buf)
691 !
692 CALL timestop(handle)
693 !
694 END SUBROUTINE apply_op_1
695
696!MERGE
697! **************************************************************************************************
698!> \brief ...
699!> \param v ...
700!> \param psi0 ...
701!> \param S_psi0 ...
702! **************************************************************************************************
703 SUBROUTINE preortho(v, psi0, S_psi0)
704 !v = (I-PS)v
705 !
706 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: v, psi0, s_psi0
707
708 CHARACTER(LEN=*), PARAMETER :: routinen = 'preortho'
709
710 INTEGER :: handle, ispin, mp, mt, mv, np, nspins, &
711 nt, nv
712 TYPE(cp_fm_struct_type), POINTER :: tmp_fm_struct
713 TYPE(cp_fm_type) :: buf
714
715 CALL timeset(routinen, handle)
716 !
717 NULLIFY (tmp_fm_struct)
718 !
719 nspins = SIZE(v, 1)
720 !
721 DO ispin = 1, nspins
722 CALL cp_fm_get_info(v(ispin), ncol_global=mv, nrow_global=nv)
723 CALL cp_fm_get_info(psi0(ispin), ncol_global=mp, nrow_global=np)
724 !
725 CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nv, ncol_global=mp, &
726 para_env=v(ispin)%matrix_struct%para_env, &
727 context=v(ispin)%matrix_struct%context)
728 CALL cp_fm_create(buf, tmp_fm_struct)
729 CALL cp_fm_struct_release(tmp_fm_struct)
730 !
731 CALL cp_fm_get_info(buf, ncol_global=mt, nrow_global=nt)
732 cpassert(nv == np)
733 cpassert(mt >= mv)
734 cpassert(mt >= mp)
735 cpassert(nt == nv)
736 !
737 ! buf = v' * S_psi0
738 CALL parallel_gemm('T', 'N', mv, mp, nv, 1.0_dp, v(ispin), s_psi0(ispin), 0.0_dp, buf)
739 ! v = v - psi0 * buf'
740 CALL parallel_gemm('N', 'T', nv, mv, mp, -1.0_dp, psi0(ispin), buf, 1.0_dp, v(ispin))
741 !
742 CALL cp_fm_release(buf)
743 END DO
744 !
745 CALL timestop(handle)
746 !
747 END SUBROUTINE preortho
748
749! **************************************************************************************************
750!> \brief projects first index of v onto the virtual subspace
751!> \param v matrix to be projected
752!> \param psi0 matrix with occupied orbitals
753!> \param S_psi0 matrix containing product of metric and occupied orbitals
754! **************************************************************************************************
755 SUBROUTINE postortho(v, psi0, S_psi0)
756 !v = (I-SP)v
757 !
758 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: v, psi0, s_psi0
759
760 CHARACTER(LEN=*), PARAMETER :: routinen = 'postortho'
761
762 INTEGER :: handle, ispin, mp, mt, mv, np, nspins, &
763 nt, nv
764 TYPE(cp_fm_struct_type), POINTER :: tmp_fm_struct
765 TYPE(cp_fm_type) :: buf
766
767 CALL timeset(routinen, handle)
768 !
769 NULLIFY (tmp_fm_struct)
770 !
771 nspins = SIZE(v, 1)
772 !
773 DO ispin = 1, nspins
774 CALL cp_fm_get_info(v(ispin), ncol_global=mv, nrow_global=nv)
775 CALL cp_fm_get_info(psi0(ispin), ncol_global=mp, nrow_global=np)
776 !
777 CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nv, ncol_global=mp, &
778 para_env=v(ispin)%matrix_struct%para_env, &
779 context=v(ispin)%matrix_struct%context)
780 CALL cp_fm_create(buf, tmp_fm_struct)
781 CALL cp_fm_struct_release(tmp_fm_struct)
782 !
783 CALL cp_fm_get_info(buf, ncol_global=mt, nrow_global=nt)
784 cpassert(nv == np)
785 cpassert(mt >= mv)
786 cpassert(mt >= mp)
787 cpassert(nt == nv)
788 !
789 ! buf = v' * psi0
790 CALL parallel_gemm('T', 'N', mv, mp, nv, 1.0_dp, v(ispin), psi0(ispin), 0.0_dp, buf)
791 ! v = v - S_psi0 * buf'
792 CALL parallel_gemm('N', 'T', nv, mv, mp, -1.0_dp, s_psi0(ispin), buf, 1.0_dp, v(ispin))
793 !
794 CALL cp_fm_release(buf)
795 END DO
796 !
797 CALL timestop(handle)
798 !
799 END SUBROUTINE postortho
800
801! **************************************************************************************************
802!> \brief ...
803!> \param qs_env ...
804!> \param linres_section ...
805!> \param vec ...
806!> \param ivec ...
807!> \param tag ...
808!> \param ind ...
809! **************************************************************************************************
810 SUBROUTINE linres_write_restart(qs_env, linres_section, vec, ivec, tag, ind)
811 TYPE(qs_environment_type), POINTER :: qs_env
812 TYPE(section_vals_type), POINTER :: linres_section
813 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: vec
814 INTEGER, INTENT(IN) :: ivec
815 CHARACTER(LEN=*) :: tag
816 INTEGER, INTENT(IN), OPTIONAL :: ind
817
818 CHARACTER(LEN=*), PARAMETER :: routinen = 'linres_write_restart'
819
820 CHARACTER(LEN=default_path_length) :: filename
821 CHARACTER(LEN=default_string_length) :: my_middle, my_pos, my_status
822 INTEGER :: handle, i, i_block, ia, ie, iounit, &
823 ispin, j, max_block, nao, nmo, nspins, &
824 rst_unit
825 REAL(kind=dp), DIMENSION(:, :), POINTER :: vecbuffer
826 TYPE(cp_fm_type), POINTER :: mo_coeff
827 TYPE(cp_logger_type), POINTER :: logger
828 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
829 TYPE(mp_para_env_type), POINTER :: para_env
830 TYPE(section_vals_type), POINTER :: print_key
831
832 NULLIFY (logger, mo_coeff, mos, para_env, print_key, vecbuffer)
833
834 CALL timeset(routinen, handle)
835
836 logger => cp_get_default_logger()
837
838 IF (btest(cp_print_key_should_output(logger%iter_info, linres_section, "PRINT%RESTART", &
839 used_print_key=print_key), &
840 cp_p_file)) THEN
841
842 iounit = cp_print_key_unit_nr(logger, linres_section, &
843 "PRINT%PROGRAM_RUN_INFO", extension=".Log")
844
845 CALL get_qs_env(qs_env=qs_env, &
846 mos=mos, &
847 para_env=para_env)
848
849 nspins = SIZE(mos)
850
851 my_status = "REPLACE"
852 my_pos = "REWIND"
853 CALL xstring(tag, ia, ie)
854 IF (PRESENT(ind)) THEN
855 my_middle = "RESTART-"//tag(ia:ie)//trim(adjustl(cp_to_string(ivec)))
856 ELSE
857 my_middle = "RESTART-"//tag(ia:ie)
858 IF (ivec > 1) THEN
859 my_status = "OLD"
860 my_pos = "APPEND"
861 END IF
862 END IF
863 rst_unit = cp_print_key_unit_nr(logger, linres_section, "PRINT%RESTART", &
864 extension=".lr", middle_name=trim(my_middle), file_status=trim(my_status), &
865 file_position=trim(my_pos), file_action="WRITE", file_form="UNFORMATTED")
866
867 filename = cp_print_key_generate_filename(logger, print_key, &
868 extension=".lr", middle_name=trim(my_middle), my_local=.false.)
869
870 IF (iounit > 0) THEN
871 WRITE (unit=iounit, fmt="(T2,A)") &
872 "LINRES| Writing response functions to the restart file <"//trim(adjustl(filename))//">"
873 END IF
874
875 !
876 ! write data to file
877 ! use the scalapack block size as a default for buffering columns
878 CALL get_mo_set(mos(1), mo_coeff=mo_coeff)
879 CALL cp_fm_get_info(mo_coeff, nrow_global=nao, ncol_block=max_block)
880 ALLOCATE (vecbuffer(nao, max_block))
881
882 IF (PRESENT(ind)) THEN
883 IF (rst_unit > 0) WRITE (rst_unit) ind, ivec, nspins, nao
884 ELSE
885 IF (rst_unit > 0) WRITE (rst_unit) ivec, nspins, nao
886 END IF
887
888 DO ispin = 1, nspins
889 CALL cp_fm_get_info(vec(ispin), ncol_global=nmo)
890
891 IF (rst_unit > 0) WRITE (rst_unit) nmo
892
893 DO i = 1, nmo, max(max_block, 1)
894 i_block = min(max_block, nmo - i + 1)
895 CALL cp_fm_get_submatrix(vec(ispin), vecbuffer, 1, i, nao, i_block)
896 ! doing this in one write would increase efficiency, but breaks RESTART compatibility.
897 ! to old ones, and in cases where max_block is different between runs, as might happen during
898 ! restarts with a different number of CPUs
899 DO j = 1, i_block
900 IF (rst_unit > 0) WRITE (rst_unit) vecbuffer(1:nao, j)
901 END DO
902 END DO
903 END DO
904
905 DEALLOCATE (vecbuffer)
906
907 CALL cp_print_key_finished_output(rst_unit, logger, linres_section, &
908 "PRINT%RESTART")
909 END IF
910
911 CALL timestop(handle)
912
913 END SUBROUTINE linres_write_restart
914
915! **************************************************************************************************
916!> \brief ...
917!> \param qs_env ...
918!> \param linres_section ...
919!> \param vec ...
920!> \param ivec ...
921!> \param tag ...
922!> \param ind ...
923! **************************************************************************************************
924 SUBROUTINE linres_read_restart(qs_env, linres_section, vec, ivec, tag, ind)
925 TYPE(qs_environment_type), POINTER :: qs_env
926 TYPE(section_vals_type), POINTER :: linres_section
927 TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: vec
928 INTEGER, INTENT(IN) :: ivec
929 CHARACTER(LEN=*) :: tag
930 INTEGER, INTENT(INOUT), OPTIONAL :: ind
931
932 CHARACTER(LEN=*), PARAMETER :: routinen = 'linres_read_restart'
933
934 CHARACTER(LEN=default_path_length) :: filename
935 CHARACTER(LEN=default_string_length) :: my_middle
936 INTEGER :: handle, i, i_block, ia, ie, iostat, iounit, ispin, iv, iv1, ivec_tmp, j, &
937 max_block, n_rep_val, nao, nao_tmp, nmo, nmo_tmp, nspins, nspins_tmp, rst_unit
938 LOGICAL :: file_exists
939 REAL(kind=dp), DIMENSION(:, :), POINTER :: vecbuffer
940 TYPE(cp_fm_type), POINTER :: mo_coeff
941 TYPE(cp_logger_type), POINTER :: logger
942 TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
943 TYPE(mp_para_env_type), POINTER :: para_env
944 TYPE(section_vals_type), POINTER :: print_key
945
946 file_exists = .false.
947
948 CALL timeset(routinen, handle)
949
950 NULLIFY (mos, para_env, logger, print_key, vecbuffer)
951 logger => cp_get_default_logger()
952
953 iounit = cp_print_key_unit_nr(logger, linres_section, &
954 "PRINT%PROGRAM_RUN_INFO", extension=".Log")
955
956 CALL get_qs_env(qs_env=qs_env, &
957 para_env=para_env, &
958 mos=mos)
959
960 nspins = SIZE(mos)
961
962 rst_unit = -1
963 IF (para_env%is_source()) THEN
964 CALL section_vals_val_get(linres_section, "WFN_RESTART_FILE_NAME", &
965 n_rep_val=n_rep_val)
966
967 CALL xstring(tag, ia, ie)
968 IF (PRESENT(ind)) THEN
969 my_middle = "RESTART-"//tag(ia:ie)//trim(adjustl(cp_to_string(ivec)))
970 ELSE
971 my_middle = "RESTART-"//tag(ia:ie)
972 END IF
973
974 IF (n_rep_val > 0) THEN
975 CALL section_vals_val_get(linres_section, "WFN_RESTART_FILE_NAME", c_val=filename)
976 CALL xstring(filename, ia, ie)
977 filename = filename(ia:ie)//trim(my_middle)//".lr"
978 ELSE
979 ! try to read from the filename that is generated automatically from the printkey
980 print_key => section_vals_get_subs_vals(linres_section, "PRINT%RESTART")
981 filename = cp_print_key_generate_filename(logger, print_key, &
982 extension=".lr", middle_name=trim(my_middle), my_local=.false.)
983 END IF
984 INQUIRE (file=filename, exist=file_exists)
985 !
986 ! open file
987 IF (file_exists) THEN
988 CALL open_file(file_name=trim(filename), &
989 file_action="READ", &
990 file_form="UNFORMATTED", &
991 file_position="REWIND", &
992 file_status="OLD", &
993 unit_number=rst_unit)
994
995 IF (iounit > 0) WRITE (iounit, "(T2,A)") &
996 "LINRES| Reading response wavefunctions from the restart file <"//trim(adjustl(filename))//">"
997 ELSE
998 IF (iounit > 0) WRITE (iounit, "(T2,A)") &
999 "LINRES| Restart file <"//trim(adjustl(filename))//"> not found"
1000 END IF
1001 END IF
1002
1003 CALL para_env%bcast(file_exists)
1004
1005 IF (file_exists) THEN
1006
1007 CALL get_mo_set(mos(1), mo_coeff=mo_coeff)
1008 CALL cp_fm_get_info(mo_coeff, nrow_global=nao, ncol_block=max_block)
1009
1010 ALLOCATE (vecbuffer(nao, max_block))
1011 !
1012 ! read headers
1013 IF (PRESENT(ind)) THEN
1014 iv1 = ivec
1015 ELSE
1016 iv1 = 1
1017 END IF
1018 DO iv = iv1, ivec
1019
1020 IF (PRESENT(ind)) THEN
1021 IF (rst_unit > 0) READ (rst_unit, iostat=iostat) ind, ivec_tmp, nspins_tmp, nao_tmp
1022 CALL para_env%bcast(iostat)
1023 CALL para_env%bcast(ind)
1024 ELSE
1025 IF (rst_unit > 0) READ (rst_unit, iostat=iostat) ivec_tmp, nspins_tmp, nao_tmp
1026 CALL para_env%bcast(iostat)
1027 END IF
1028
1029 IF (iostat .NE. 0) EXIT
1030 CALL para_env%bcast(ivec_tmp)
1031 CALL para_env%bcast(nspins_tmp)
1032 CALL para_env%bcast(nao_tmp)
1033
1034 ! check that the number nao, nmo and nspins are
1035 ! the same as in the current mos
1036 IF (nspins_tmp .NE. nspins) cpabort("nspins not consistent")
1037 IF (nao_tmp .NE. nao) cpabort("nao not consistent")
1038 !
1039 DO ispin = 1, nspins
1040 CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff)
1041 CALL cp_fm_get_info(mo_coeff, ncol_global=nmo)
1042 !
1043 IF (rst_unit > 0) READ (rst_unit) nmo_tmp
1044 CALL para_env%bcast(nmo_tmp)
1045 IF (nmo_tmp .NE. nmo) cpabort("nmo not consistent")
1046 !
1047 ! read the response
1048 DO i = 1, nmo, max(max_block, 1)
1049 i_block = min(max_block, nmo - i + 1)
1050 DO j = 1, i_block
1051 IF (rst_unit > 0) READ (rst_unit) vecbuffer(1:nao, j)
1052 END DO
1053 IF (iv .EQ. ivec_tmp) THEN
1054 CALL para_env%bcast(vecbuffer)
1055 CALL cp_fm_set_submatrix(vec(ispin), vecbuffer, 1, i, nao, i_block)
1056 END IF
1057 END DO
1058 END DO
1059 IF (ivec .EQ. ivec_tmp) EXIT
1060 END DO
1061
1062 IF (iostat /= 0) THEN
1063 IF (iounit > 0) WRITE (iounit, "(T2,A)") &
1064 "LINRES| Restart file <"//trim(adjustl(filename))//"> not found"
1065 END IF
1066
1067 DEALLOCATE (vecbuffer)
1068
1069 END IF
1070
1071 IF (para_env%is_source()) THEN
1072 IF (file_exists) CALL close_file(unit_number=rst_unit)
1073 END IF
1074
1075 CALL timestop(handle)
1076
1077 END SUBROUTINE linres_read_restart
1078
1079! **************************************************************************************************
1080!> \brief ...
1081!> \param p_env ...
1082!> \param linres_control ...
1083!> \param nspins ...
1084! **************************************************************************************************
1085 SUBROUTINE check_p_env_init(p_env, linres_control, nspins)
1086 !
1087 TYPE(qs_p_env_type) :: p_env
1088 TYPE(linres_control_type), INTENT(IN) :: linres_control
1089 INTEGER, INTENT(IN) :: nspins
1090
1091 INTEGER :: ispin, ncol, nrow
1092
1093 IF (linres_control%preconditioner_type /= ot_precond_none) THEN
1094 cpassert(ASSOCIATED(p_env%preconditioner))
1095 DO ispin = 1, nspins
1096 CALL cp_fm_get_info(p_env%PS_psi0(ispin), nrow_global=nrow, ncol_global=ncol)
1097 cpassert(nrow == p_env%n_ao(ispin))
1098 cpassert(ncol == p_env%n_mo(ispin))
1099 END DO
1100 END IF
1101
1102 END SUBROUTINE check_p_env_init
1103
1104END MODULE qs_linres_methods
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_set(matrix, alpha)
...
real(kind=dp) function, public dbcsr_checksum(matrix, pos)
Calculates the checksum of a DBCSR matrix.
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
Routines to handle the external control of CP2K.
subroutine, public external_control(should_stop, flag, globenv, target_time, start_time, force_check)
External manipulations during a run : when the <PROJECT_NAME>.EXIT_$runtype command is sent the progr...
Utility routines to open and close files. Tracking of preconnections.
Definition cp_files.F:16
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
Definition cp_files.F:308
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Definition cp_files.F:119
basic linear algebra operations for full matrices
subroutine, public cp_fm_scale_and_add(alpha, matrix_a, beta, matrix_b)
calc A <- alpha*A + beta*B optimized for alpha == 1.0 (just add beta*B) and beta == 0....
represent the structure of a full matrix
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
subroutine, public cp_fm_set_submatrix(fm, new_values, start_row, start_col, n_rows, n_cols, alpha, beta, transpose)
sets a submatrix of a full matrix fm(start_row:start_row+n_rows,start_col:start_col+n_cols) = alpha*o...
subroutine, public cp_fm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
gets a submatrix of a full matrix op(target_m)(1:n_rows,1:n_cols) =fm(start_row:start_row+n_rows,...
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
various routines to log and control the output. The idea is that decisions about where to log should ...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
character(len=default_path_length) function, public cp_print_key_generate_filename(logger, print_key, middle_name, extension, my_local)
Utility function that returns a unit number to write the print key. Might open a file with a unique f...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public state_loc_all
integer, parameter, public do_loc_none
integer, parameter, public op_loc_berry
integer, parameter, public ot_precond_solver_default
integer, parameter, public ot_precond_none
objects that represent the structure of input sections and the data contained in an input section
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
integer, parameter, public default_path_length
Definition kinds.F:58
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:130
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition machine.F:147
Interface to the message passing library MPI.
basic linear algebra operations for full matrixes
computes preconditioners, and implements methods to apply them currently used in qs_ot
subroutine, public make_preconditioner(preconditioner_env, precon_type, solver_type, matrix_h, matrix_s, matrix_t, mo_set, energy_gap, convert_precond_to_dbcsr, chol_type)
...
Routines to calculate 2nd order kernels from a given response density in ao basis linear response scf...
subroutine, public build_dm_response(c0, c1, dm)
This routine builds response density in dbcsr format.
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, ecoul_1c, rho0_s_rs, rho0_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs)
Get the QUICKSTEP environment.
subroutine, public prepare_gapw_den(qs_env, local_rho_set, do_rho0, kind_set_external, pw_env_sub)
...
linres kernel functions
subroutine, public apply_op_2(qs_env, p_env, c0, av)
...
localize wavefunctions linear response scf
subroutine, public linres_write_restart(qs_env, linres_section, vec, ivec, tag, ind)
...
subroutine, public linres_read_restart(qs_env, linres_section, vec, ivec, tag, ind)
...
subroutine, public linres_solver(p_env, qs_env, psi1, h1_psi0, psi0_order, iounit, should_stop)
scf loop to optimize the first order wavefunctions (psi1) given a perturbation as an operator applied...
subroutine, public linres_localize(qs_env, linres_control, nspins, centers_only)
Find the centers and spreads of the wfn, if required apply a localization algorithm.
Type definitiona for linear response calculations.
Driver for the localization that should be general for all the methods available and all the definiti...
Definition qs_loc_main.F:22
subroutine, public qs_loc_driver(qs_env, qs_loc_env, print_loc_section, myspin, ext_mo_coeff)
set up the calculation of localized orbitals
Definition qs_loc_main.F:96
New version of the module for the localization of the molecular orbitals This should be able to use d...
subroutine, public get_qs_loc_env(qs_loc_env, cell, local_molecules, localized_wfn_control, moloc_coeff, op_sm_set, op_fm_set, para_env, particle_set, weights, dim_op)
...
subroutine, public qs_loc_env_create(qs_loc_env)
...
Some utilities for the construction of the localization environment.
subroutine, public loc_write_restart(qs_loc_env, section, mo_array, coeff_localized, do_homo, evals, do_mixed)
...
subroutine, public qs_loc_control_init(qs_loc_env, loc_section, do_homo, do_mixed, do_xas, nloc_xas, spin_xas)
initializes everything needed for localization of the HOMOs
subroutine, public qs_loc_init(qs_env, qs_loc_env, localize_section, mos_localized, do_homo, do_mo_cubes, mo_loc_history, evals, tot_zeff_corr, do_mixed)
initializes everything needed for localization of the molecular orbitals
Definition and initialisation of the mo data type.
Definition qs_mo_types.F:22
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
Utility functions for the perturbation calculations.
subroutine, public p_env_update_rho(p_env, qs_env)
...
subroutine, public p_env_check_i_alloc(p_env, qs_env)
checks that the intenal storage is allocated, and allocs it if needed
basis types for the calculation of the perturbation of density theory.
methods of the rho structure (defined in qs_rho_types)
subroutine, public qs_rho_update_rho(rho_struct, qs_env, rho_xc_external, local_rho_set, task_list_external, task_list_external_soft, pw_env_external, para_env_external)
updates rho_r and rho_g to the rhorho_ao. if use_kinetic_energy_density also computes tau_r and tau_g...
superstucture that hold various representations of the density and keeps track of which ones are vali...
Utilities for string manipulations.
elemental subroutine, public xstring(string, ia, ib)
...
keeps the information about the structure of a full matrix
represent a full matrix
type of a logger, at the moment it contains just a print level starting at which level it should be l...
stores all the informations relevant to an mpi environment
General settings for linear response calculations.
A type that holds controlling information for the calculation of the spread of wfn and the optimizati...
contains all the info needed by quickstep to calculate the spread of a selected set of orbitals and i...
Represent a qs system that is perturbed. Can calculate the linear operator and the rhs of the system ...
keeps the density in various representations, keeping track of which ones are valid.