(git:98357aa)
Loading...
Searching...
No Matches
almo_scf_optimizer.F
Go to the documentation of this file.
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 Optimization routines for all ALMO-based SCF methods
10!> \par History
11!> 2011.05 created [Rustam Z Khaliullin]
12!> 2014.10 as a separate file [Rustam Z Khaliullin]
13!> \author Rustam Z Khaliullin
14! **************************************************************************************************
15MODULE almo_scf_optimizer
16 USE almo_scf_diis_types, ONLY: almo_scf_diis_extrapolate,&
17 almo_scf_diis_init,&
18 almo_scf_diis_push,&
19 almo_scf_diis_release,&
20 almo_scf_diis_type
21 USE almo_scf_lbfgs_types, ONLY: lbfgs_create,&
22 lbfgs_get_direction,&
23 lbfgs_history_type,&
24 lbfgs_release,&
25 lbfgs_seed
26 USE almo_scf_methods, ONLY: &
27 almo_scf_ks_blk_to_tv_blk, almo_scf_ks_to_ks_blk, almo_scf_ks_to_ks_xx, &
28 almo_scf_ks_xx_to_tv_xx, almo_scf_p_blk_to_t_blk, almo_scf_t_rescaling, &
29 almo_scf_t_to_proj, apply_domain_operators, apply_projector, &
30 construct_domain_preconditioner, construct_domain_r_down, construct_domain_s_inv, &
31 construct_domain_s_sqrt, fill_matrix_with_ones, get_overlap, orthogonalize_mos, &
32 pseudo_invert_diagonal_blk, xalmo_initial_guess
33 USE almo_scf_qs, ONLY: almo_dm_to_almo_ks,&
34 almo_dm_to_qs_env,&
35 almo_scf_update_ks_energy,&
36 matrix_qs_to_almo
37 USE almo_scf_types, ONLY: almo_scf_env_type,&
38 optimizer_options_type
39 USE cell_types, ONLY: cell_type
40 USE cp_blacs_env, ONLY: cp_blacs_env_type
41 USE cp_dbcsr_api, ONLY: &
42 dbcsr_add, dbcsr_copy, dbcsr_create, dbcsr_desymmetrize, dbcsr_distribution_get, &
43 dbcsr_distribution_type, dbcsr_filter, dbcsr_finalize, dbcsr_get_block_p, dbcsr_get_info, &
44 dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, dbcsr_iterator_readonly_start, &
45 dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_multiply, &
46 dbcsr_p_type, dbcsr_put_block, dbcsr_release, dbcsr_scale, dbcsr_set, dbcsr_type, &
47 dbcsr_type_no_symmetry, dbcsr_work_create
48 USE cp_dbcsr_cholesky, ONLY: cp_dbcsr_cholesky_decompose,&
49 cp_dbcsr_cholesky_invert,&
50 cp_dbcsr_cholesky_restore
51 USE cp_dbcsr_contrib, ONLY: dbcsr_add_on_diag,&
52 dbcsr_dot,&
53 dbcsr_frobenius_norm,&
54 dbcsr_get_diag,&
55 dbcsr_hadamard_product,&
56 dbcsr_maxabs,&
57 dbcsr_set_diag
58 USE cp_external_control, ONLY: external_control
59 USE cp_files, ONLY: close_file,&
60 open_file
61 USE cp_log_handling, ONLY: cp_get_default_logger,&
62 cp_logger_get_default_unit_nr,&
63 cp_logger_type,&
64 cp_to_string
65 USE cp_output_handling, ONLY: cp_print_key_finished_output,&
66 cp_print_key_unit_nr
67 USE ct_methods, ONLY: analytic_line_search,&
68 ct_step_execute,&
69 diagonalize_diagonal_blocks
70 USE ct_types, ONLY: ct_step_env_clean,&
71 ct_step_env_get,&
72 ct_step_env_init,&
73 ct_step_env_set,&
74 ct_step_env_type
75 USE domain_submatrix_methods, ONLY: construct_submatrices,&
76 copy_submatrices,&
77 init_submatrices,&
78 maxnorm_submatrices,&
79 release_submatrices
80 USE domain_submatrix_types, ONLY: domain_map_type,&
81 domain_submatrix_type,&
82 select_row
83 USE input_constants, ONLY: &
84 almo_scf_diag, almo_scf_dm_sign, cg_dai_yuan, cg_fletcher, cg_fletcher_reeves, &
85 cg_hager_zhang, cg_hestenes_stiefel, cg_liu_storey, cg_polak_ribiere, cg_zero, &
86 op_loc_berry, op_loc_pipek, trustr_cauchy, trustr_dogleg, virt_full, &
87 xalmo_case_block_diag, xalmo_case_fully_deloc, xalmo_case_normal, xalmo_prec_domain, &
88 xalmo_prec_full, xalmo_prec_zero
89 USE input_section_types, ONLY: section_vals_get_subs_vals,&
90 section_vals_type
91 USE iterate_matrix, ONLY: determinant,&
92 invert_hotelling,&
93 matrix_sqrt_newton_schulz
94 USE kinds, ONLY: dp
95 USE machine, ONLY: m_flush,&
96 m_walltime
97 USE message_passing, ONLY: mp_comm_type,&
98 mp_para_env_type
99 USE particle_methods, ONLY: get_particle_set
100 USE particle_types, ONLY: particle_type
101 USE qs_energy_types, ONLY: qs_energy_type
102 USE qs_environment_types, ONLY: get_qs_env,&
103 qs_environment_type
104 USE qs_kind_types, ONLY: qs_kind_type
105 USE qs_loc_utils, ONLY: compute_berry_operator
106 USE qs_localization_methods, ONLY: initialize_weights
107#include "./base/base_uses.f90"
108
109 IMPLICIT NONE
110
111 PRIVATE
112
113 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'almo_scf_optimizer'
114
115 PUBLIC :: almo_scf_block_diagonal, &
116 almo_scf_xalmo_eigensolver, &
117 almo_scf_xalmo_trustr, &
118 almo_scf_xalmo_pcg, &
119 almo_scf_construct_nlmos
120
121 LOGICAL, PARAMETER :: debug_mode = .false.
122 LOGICAL, PARAMETER :: safe_mode = .false.
123 LOGICAL, PARAMETER :: almo_mathematica = .false.
124 INTEGER, PARAMETER :: hessian_path_reuse = 1, &
125 hessian_path_assemble = 2
126
127CONTAINS
128
129! **************************************************************************************************
130!> \brief An SCF procedure that optimizes block-diagonal ALMOs using DIIS
131!> \param qs_env ...
132!> \param almo_scf_env ...
133!> \param optimizer ...
134!> \par History
135!> 2011.06 created [Rustam Z Khaliullin]
136!> 2018.09 smearing support [Ruben Staub]
137!> \author Rustam Z Khaliullin
138! **************************************************************************************************
139 SUBROUTINE almo_scf_block_diagonal(qs_env, almo_scf_env, optimizer)
140 TYPE(qs_environment_type), POINTER :: qs_env
141 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
142 TYPE(optimizer_options_type), INTENT(IN) :: optimizer
143
144 CHARACTER(len=*), PARAMETER :: routinen = 'almo_scf_block_diagonal'
145
146 INTEGER :: handle, iscf, ispin, nspin, unit_nr
147 INTEGER, ALLOCATABLE, DIMENSION(:) :: local_nocc_of_domain
148 LOGICAL :: converged, prepare_to_exit, should_stop, &
149 use_diis, use_prev_as_guess
150 REAL(kind=dp) :: density_rec, energy_diff, energy_new, energy_old, error_norm, &
151 error_norm_ispin, kts_sum, prev_error_norm, t1, t2, true_mixing_fraction
152 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: local_mu
153 TYPE(almo_scf_diis_type), ALLOCATABLE, &
154 DIMENSION(:) :: almo_diis
155 TYPE(cp_logger_type), POINTER :: logger
156 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: matrix_mixing_old_blk
157 TYPE(qs_energy_type), POINTER :: qs_energy
158
159 CALL timeset(routinen, handle)
160
161 ! get a useful output_unit
162 logger => cp_get_default_logger()
163 IF (logger%para_env%is_source()) THEN
164 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
165 ELSE
166 unit_nr = -1
167 END IF
168
169 ! use DIIS, it's superior to simple mixing
170 use_diis = .true.
171 use_prev_as_guess = .false.
172
173 nspin = almo_scf_env%nspins
174 ALLOCATE (local_mu(almo_scf_env%ndomains))
175 ALLOCATE (local_nocc_of_domain(almo_scf_env%ndomains))
176
177 ! init mixing matrices
178 ALLOCATE (matrix_mixing_old_blk(nspin))
179 ALLOCATE (almo_diis(nspin))
180 DO ispin = 1, nspin
181 CALL dbcsr_create(matrix_mixing_old_blk(ispin), &
182 template=almo_scf_env%matrix_ks_blk(ispin))
183 CALL almo_scf_diis_init(diis_env=almo_diis(ispin), &
184 sample_err=almo_scf_env%matrix_ks_blk(ispin), &
185 sample_var=almo_scf_env%matrix_s_blk(1), &
186 error_type=1, &
187 max_length=optimizer%ndiis)
188 END DO
189
190 CALL get_qs_env(qs_env, energy=qs_energy)
191 energy_old = qs_energy%total
192
193 iscf = 0
194 prepare_to_exit = .false.
195 true_mixing_fraction = 0.0_dp
196 error_norm = 1.0e+10_dp ! arbitrary big step
197
198 IF (unit_nr > 0) THEN
199 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 20), &
200 " Optimization of block-diagonal ALMOs ", repeat("-", 21)
201 WRITE (unit_nr, *)
202 WRITE (unit_nr, '(T2,A13,A6,A23,A14,A14,A9)') "Method", "Iter", &
203 "Total Energy", "Change", "Convergence", "Time"
204 WRITE (unit_nr, '(T2,A)') repeat("-", 79)
205 END IF
206
207 ! the real SCF loop
208 t1 = m_walltime()
209 DO
210
211 iscf = iscf + 1
212
213 ! obtain projected KS matrix and the DIIS-error vector
214 CALL almo_scf_ks_to_ks_blk(almo_scf_env)
215
216 ! inform the DIIS handler about the new KS matrix and its error vector
217 IF (use_diis) THEN
218 DO ispin = 1, nspin
219 CALL almo_scf_diis_push(diis_env=almo_diis(ispin), &
220 var=almo_scf_env%matrix_ks_blk(ispin), &
221 err=almo_scf_env%matrix_err_blk(ispin))
222 END DO
223 END IF
224
225 ! get error_norm: choose the largest of the two spins
226 prev_error_norm = error_norm
227 DO ispin = 1, nspin
228 error_norm_ispin = dbcsr_maxabs(almo_scf_env%matrix_err_blk(ispin))
229 IF (ispin == 1) error_norm = error_norm_ispin
230 IF (ispin > 1 .AND. error_norm_ispin > error_norm) THEN
231 error_norm = error_norm_ispin
232 END IF
233 END DO
234
235 IF (error_norm < almo_scf_env%eps_prev_guess) THEN
236 use_prev_as_guess = .true.
237 ELSE
238 use_prev_as_guess = .false.
239 END IF
240
241 ! check convergence
242 converged = .true.
243 IF (error_norm > optimizer%eps_error) converged = .false.
244
245 ! check other exit criteria: max SCF steps and timing
246 CALL external_control(should_stop, "SCF", &
247 start_time=qs_env%start_time, &
248 target_time=qs_env%target_time)
249 IF (should_stop .OR. iscf >= optimizer%max_iter .OR. converged) THEN
250 prepare_to_exit = .true.
251 IF (iscf == 1) energy_new = energy_old
252 END IF
253
254 ! if early stopping is on do at least one iteration
255 IF (optimizer%early_stopping_on .AND. iscf == 1) THEN
256 prepare_to_exit = .false.
257 END IF
258
259 IF (.NOT. prepare_to_exit) THEN ! update the ALMOs and density matrix
260
261 ! perform mixing of KS matrices
262 IF (iscf /= 1) THEN
263 IF (use_diis) THEN ! use diis instead of mixing
264 DO ispin = 1, nspin
265 CALL almo_scf_diis_extrapolate(diis_env=almo_diis(ispin), &
266 extr_var=almo_scf_env%matrix_ks_blk(ispin))
267 END DO
268 ELSE ! use mixing
269 true_mixing_fraction = almo_scf_env%mixing_fraction
270 DO ispin = 1, nspin
271 CALL dbcsr_add(almo_scf_env%matrix_ks_blk(ispin), &
272 matrix_mixing_old_blk(ispin), &
273 true_mixing_fraction, &
274 1.0_dp - true_mixing_fraction)
275 END DO
276 END IF
277 END IF
278 ! save the new matrix for the future mixing
279 DO ispin = 1, nspin
280 CALL dbcsr_copy(matrix_mixing_old_blk(ispin), &
281 almo_scf_env%matrix_ks_blk(ispin))
282 END DO
283
284 ! obtain ALMOs from the new KS matrix
285 SELECT CASE (almo_scf_env%almo_update_algorithm)
286 CASE (almo_scf_diag)
287
288 CALL almo_scf_ks_blk_to_tv_blk(almo_scf_env)
289
290 CASE (almo_scf_dm_sign)
291
292 ! update the density matrix
293 DO ispin = 1, nspin
294
295 local_nocc_of_domain(:) = almo_scf_env%nocc_of_domain(:, ispin)
296 local_mu(:) = almo_scf_env%mu_of_domain(:, ispin)
297 cpabort("Density_matrix_sign has not been tested yet")
298 almo_scf_env%mu_of_domain(:, ispin) = local_mu(:)
299
300 END DO
301
302 ! obtain ALMOs from matrix_p_blk: T_new = P_blk S_blk T_old
303 CALL almo_scf_p_blk_to_t_blk(almo_scf_env, ionic=.false.)
304
305 DO ispin = 1, almo_scf_env%nspins
306
307 CALL orthogonalize_mos(ket=almo_scf_env%matrix_t_blk(ispin), &
308 overlap=almo_scf_env%matrix_sigma_blk(ispin), &
309 metric=almo_scf_env%matrix_s_blk(1), &
310 retain_locality=.true., &
311 only_normalize=.false., &
312 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), &
313 eps_filter=almo_scf_env%eps_filter, &
314 order_lanczos=almo_scf_env%order_lanczos, &
315 eps_lanczos=almo_scf_env%eps_lanczos, &
316 max_iter_lanczos=almo_scf_env%max_iter_lanczos)
317
318 END DO
319
320 END SELECT
321
322 ! obtain density matrix from ALMOs
323 DO ispin = 1, almo_scf_env%nspins
324
325 !! Application of an occupation-rescaling trick for smearing, if requested
326 IF (almo_scf_env%smear) THEN
327 CALL almo_scf_t_rescaling(matrix_t=almo_scf_env%matrix_t_blk(ispin), &
328 mo_energies=almo_scf_env%mo_energies(:, ispin), &
329 mu_of_domain=almo_scf_env%mu_of_domain(:, ispin), &
330 real_ne_of_domain=almo_scf_env%real_ne_of_domain(:, ispin), &
331 spin_kts=almo_scf_env%kTS(ispin), &
332 smear_e_temp=almo_scf_env%smear_e_temp, &
333 ndomains=almo_scf_env%ndomains, &
334 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin))
335 END IF
336
337 CALL almo_scf_t_to_proj(t=almo_scf_env%matrix_t_blk(ispin), &
338 p=almo_scf_env%matrix_p(ispin), &
339 eps_filter=almo_scf_env%eps_filter, &
340 orthog_orbs=.false., &
341 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), &
342 s=almo_scf_env%matrix_s(1), &
343 sigma=almo_scf_env%matrix_sigma(ispin), &
344 sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), &
345 use_guess=use_prev_as_guess, &
346 smear=almo_scf_env%smear, &
347 algorithm=almo_scf_env%sigma_inv_algorithm, &
348 inverse_accelerator=almo_scf_env%order_lanczos, &
349 inv_eps_factor=almo_scf_env%matrix_iter_eps_error_factor, &
350 eps_lanczos=almo_scf_env%eps_lanczos, &
351 max_iter_lanczos=almo_scf_env%max_iter_lanczos, &
352 para_env=almo_scf_env%para_env, &
353 blacs_env=almo_scf_env%blacs_env)
354
355 END DO
356
357 IF (almo_scf_env%nspins == 1) THEN
358 CALL dbcsr_scale(almo_scf_env%matrix_p(1), 2.0_dp)
359 !! Rescaling electronic entropy contribution by spin_factor
360 IF (almo_scf_env%smear) THEN
361 almo_scf_env%kTS(1) = almo_scf_env%kTS(1)*2.0_dp
362 END IF
363 END IF
364
365 IF (almo_scf_env%smear) THEN
366 kts_sum = sum(almo_scf_env%kTS)
367 ELSE
368 kts_sum = 0.0_dp
369 END IF
370
371 ! compute the new KS matrix and new energy
372 CALL almo_dm_to_almo_ks(qs_env, &
373 almo_scf_env%matrix_p, &
374 almo_scf_env%matrix_ks, &
375 energy_new, &
376 almo_scf_env%eps_filter, &
377 almo_scf_env%mat_distr_aos, &
378 smear=almo_scf_env%smear, &
379 kts_sum=kts_sum)
380
381 END IF ! prepare_to_exit
382
383 energy_diff = energy_new - energy_old
384 energy_old = energy_new
385 almo_scf_env%almo_scf_energy = energy_new
386
387 t2 = m_walltime()
388 ! brief report on the current SCF loop
389 IF (unit_nr > 0) THEN
390 WRITE (unit_nr, '(T2,A13,I6,F23.10,E14.5,F14.9,F9.2)') "ALMO SCF DIIS", &
391 iscf, &
392 energy_new, energy_diff, error_norm, t2 - t1
393 END IF
394 t1 = m_walltime()
395
396 IF (prepare_to_exit) EXIT
397
398 END DO ! end scf cycle
399
400 !! Print number of electrons recovered if smearing was requested
401 IF (almo_scf_env%smear) THEN
402 DO ispin = 1, nspin
403 CALL dbcsr_dot(almo_scf_env%matrix_p(ispin), almo_scf_env%matrix_s(1), density_rec)
404 IF (unit_nr > 0) THEN
405 WRITE (unit_nr, '(T2,A20,F23.10)') "Electrons recovered:", density_rec
406 END IF
407 END DO
408 END IF
409
410 IF (.NOT. converged .AND. (.NOT. optimizer%early_stopping_on)) THEN
411 IF (unit_nr > 0) THEN
412 cpabort("SCF for block-diagonal ALMOs not converged!")
413 END IF
414 END IF
415
416 DO ispin = 1, nspin
417 CALL dbcsr_release(matrix_mixing_old_blk(ispin))
418 CALL almo_scf_diis_release(diis_env=almo_diis(ispin))
419 END DO
420 DEALLOCATE (almo_diis)
421 DEALLOCATE (matrix_mixing_old_blk)
422 DEALLOCATE (local_mu)
423 DEALLOCATE (local_nocc_of_domain)
424
425 CALL timestop(handle)
426
427 END SUBROUTINE almo_scf_block_diagonal
428
429! **************************************************************************************************
430!> \brief An eigensolver-based SCF to optimize extended ALMOs (i.e. ALMOs on
431!> overlapping domains)
432!> \param qs_env ...
433!> \param almo_scf_env ...
434!> \param optimizer ...
435!> \par History
436!> 2013.03 created [Rustam Z Khaliullin]
437!> 2018.09 smearing support [Ruben Staub]
438!> \author Rustam Z Khaliullin
439! **************************************************************************************************
440 SUBROUTINE almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer)
441 TYPE(qs_environment_type), POINTER :: qs_env
442 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
443 TYPE(optimizer_options_type), INTENT(IN) :: optimizer
444
445 CHARACTER(len=*), PARAMETER :: routinen = 'almo_scf_xalmo_eigensolver'
446
447 INTEGER :: handle, iscf, ispin, nspin, unit_nr
448 LOGICAL :: converged, prepare_to_exit, should_stop
449 REAL(kind=dp) :: denergy_tot, density_rec, energy_diff, energy_new, energy_old, error_norm, &
450 error_norm_0, kts_sum, spin_factor, t1, t2
451 REAL(kind=dp), DIMENSION(2) :: denergy_spin
452 TYPE(almo_scf_diis_type), ALLOCATABLE, &
453 DIMENSION(:) :: almo_diis
454 TYPE(cp_logger_type), POINTER :: logger
455 TYPE(dbcsr_type) :: matrix_p_almo_scf_converged
456 TYPE(domain_submatrix_type), ALLOCATABLE, &
457 DIMENSION(:, :) :: submatrix_mixing_old_blk
458
459 CALL timeset(routinen, handle)
460
461 ! get a useful output_unit
462 logger => cp_get_default_logger()
463 IF (logger%para_env%is_source()) THEN
464 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
465 ELSE
466 unit_nr = -1
467 END IF
468
469 nspin = almo_scf_env%nspins
470 IF (nspin == 1) THEN
471 spin_factor = 2.0_dp
472 ELSE
473 spin_factor = 1.0_dp
474 END IF
475
476 ! RZK-warning domain_s_sqrt and domain_s_sqrt_inv do not have spin
477 ! components yet (may be used later)
478 ispin = 1
479 CALL construct_domain_s_sqrt( &
480 matrix_s=almo_scf_env%matrix_s(1), &
481 subm_s_sqrt=almo_scf_env%domain_s_sqrt(:, ispin), &
482 subm_s_sqrt_inv=almo_scf_env%domain_s_sqrt_inv(:, ispin), &
483 dpattern=almo_scf_env%quench_t(ispin), &
484 map=almo_scf_env%domain_map(ispin), &
485 node_of_domain=almo_scf_env%cpu_of_domain)
486
487 ! construct the domain template for the occupied orbitals
488 DO ispin = 1, nspin
489 ! RZK-warning we need only the matrix structure, not data
490 ! replace construct_submatrices with lighter procedure with
491 ! no heavy communications
492 CALL construct_submatrices( &
493 matrix=almo_scf_env%quench_t(ispin), &
494 submatrix=almo_scf_env%domain_t(:, ispin), &
495 distr_pattern=almo_scf_env%quench_t(ispin), &
496 domain_map=almo_scf_env%domain_map(ispin), &
497 node_of_domain=almo_scf_env%cpu_of_domain, &
498 job_type=select_row)
499 END DO
500
501 ! init mixing matrices
502 ALLOCATE (submatrix_mixing_old_blk(almo_scf_env%ndomains, nspin))
503 CALL init_submatrices(submatrix_mixing_old_blk)
504 ALLOCATE (almo_diis(nspin))
505
506 DO ispin = 1, nspin
507 ! use s_sqrt since they are already properly constructed
508 ! and have the same distributions as domain_err and domain_ks_xx
509 CALL almo_scf_diis_init(diis_env=almo_diis(ispin), &
510 sample_err=almo_scf_env%domain_s_sqrt(:, ispin), &
511 error_type=1, &
512 max_length=optimizer%ndiis)
513 END DO
514
515 denergy_tot = 0.0_dp
516 energy_old = 0.0_dp
517 iscf = 0
518 prepare_to_exit = .false.
519
520 ! the SCF loop
521 t1 = m_walltime()
522 DO
523
524 iscf = iscf + 1
525
526 ! obtain projected KS matrix and the DIIS-error vector
527 CALL almo_scf_ks_to_ks_xx(almo_scf_env)
528
529 ! inform the DIIS handler about the new KS matrix and its error vector
530 DO ispin = 1, nspin
531 CALL almo_scf_diis_push(diis_env=almo_diis(ispin), &
532 d_var=almo_scf_env%domain_ks_xx(:, ispin), &
533 d_err=almo_scf_env%domain_err(:, ispin))
534 END DO
535
536 ! check convergence
537 converged = .true.
538 DO ispin = 1, nspin
539 error_norm = dbcsr_maxabs(almo_scf_env%matrix_err_xx(ispin))
540 CALL maxnorm_submatrices(almo_scf_env%domain_err(:, ispin), &
541 norm=error_norm_0)
542 IF (error_norm > optimizer%eps_error) THEN
543 converged = .false.
544 EXIT ! no need to check the other spin
545 END IF
546 END DO
547 ! check other exit criteria: max SCF steps and timing
548 CALL external_control(should_stop, "SCF", &
549 start_time=qs_env%start_time, &
550 target_time=qs_env%target_time)
551 IF (should_stop .OR. iscf >= optimizer%max_iter .OR. converged) THEN
552 prepare_to_exit = .true.
553 END IF
554
555 ! if early stopping is on do at least one iteration
556 IF (optimizer%early_stopping_on .AND. iscf == 1) THEN
557 prepare_to_exit = .false.
558 END IF
559
560 IF (.NOT. prepare_to_exit) THEN ! update the ALMOs and density matrix
561
562 ! perform mixing of KS matrices
563 IF (iscf /= 1) THEN
564 DO ispin = 1, nspin
565 CALL almo_scf_diis_extrapolate(diis_env=almo_diis(ispin), &
566 d_extr_var=almo_scf_env%domain_ks_xx(:, ispin))
567 END DO
568 END IF
569 ! save the new matrix for the future mixing
570 DO ispin = 1, nspin
571 CALL copy_submatrices( &
572 almo_scf_env%domain_ks_xx(:, ispin), &
573 submatrix_mixing_old_blk(:, ispin), &
574 copy_data=.true.)
575 END DO
576
577 ! obtain a new set of ALMOs from the updated KS matrix
578 CALL almo_scf_ks_xx_to_tv_xx(almo_scf_env)
579
580 ! update the density matrix
581 DO ispin = 1, nspin
582
583 ! save the initial density matrix (to get the perturbative energy lowering)
584 IF (iscf == 1) THEN
585 CALL dbcsr_create(matrix_p_almo_scf_converged, &
586 template=almo_scf_env%matrix_p(ispin))
587 CALL dbcsr_copy(matrix_p_almo_scf_converged, &
588 almo_scf_env%matrix_p(ispin))
589 END IF
590
591 !! Application of an occupation-rescaling trick for smearing, if requested
592 IF (almo_scf_env%smear) THEN
593 CALL almo_scf_t_rescaling(matrix_t=almo_scf_env%matrix_t_blk(ispin), &
594 mo_energies=almo_scf_env%mo_energies(:, ispin), &
595 mu_of_domain=almo_scf_env%mu_of_domain(:, ispin), &
596 real_ne_of_domain=almo_scf_env%real_ne_of_domain(:, ispin), &
597 spin_kts=almo_scf_env%kTS(ispin), &
598 smear_e_temp=almo_scf_env%smear_e_temp, &
599 ndomains=almo_scf_env%ndomains, &
600 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin))
601 END IF
602
603 ! update now
604 CALL almo_scf_t_to_proj( &
605 t=almo_scf_env%matrix_t(ispin), &
606 p=almo_scf_env%matrix_p(ispin), &
607 eps_filter=almo_scf_env%eps_filter, &
608 orthog_orbs=.false., &
609 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), &
610 s=almo_scf_env%matrix_s(1), &
611 sigma=almo_scf_env%matrix_sigma(ispin), &
612 sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), &
613 use_guess=.true., &
614 smear=almo_scf_env%smear, &
615 algorithm=almo_scf_env%sigma_inv_algorithm, &
616 inverse_accelerator=almo_scf_env%order_lanczos, &
617 inv_eps_factor=almo_scf_env%matrix_iter_eps_error_factor, &
618 eps_lanczos=almo_scf_env%eps_lanczos, &
619 max_iter_lanczos=almo_scf_env%max_iter_lanczos, &
620 para_env=almo_scf_env%para_env, &
621 blacs_env=almo_scf_env%blacs_env)
622 CALL dbcsr_scale(almo_scf_env%matrix_p(ispin), spin_factor)
623 !! Rescaling electronic entropy contribution by spin_factor
624 IF (almo_scf_env%smear) THEN
625 almo_scf_env%kTS(ispin) = almo_scf_env%kTS(ispin)*spin_factor
626 END IF
627
628 ! obtain perturbative estimate (at no additional cost)
629 ! of the energy lowering relative to the block-diagonal ALMOs
630 IF (iscf == 1) THEN
631
632 CALL dbcsr_add(matrix_p_almo_scf_converged, &
633 almo_scf_env%matrix_p(ispin), -1.0_dp, 1.0_dp)
634 CALL dbcsr_dot(almo_scf_env%matrix_ks_0deloc(ispin), &
635 matrix_p_almo_scf_converged, &
636 denergy_spin(ispin))
637
638 CALL dbcsr_release(matrix_p_almo_scf_converged)
639
640 !! RS-WARNING: If smearing ALMO is requested, electronic entropy contribution should probably be included here
641
642 denergy_tot = denergy_tot + denergy_spin(ispin)
643
644 END IF ! iscf.eq.1
645
646 END DO
647
648 ! print out the energy lowering
649 IF (iscf == 1) THEN
650 CALL energy_lowering_report( &
651 unit_nr=unit_nr, &
652 ref_energy=almo_scf_env%almo_scf_energy, &
653 energy_lowering=denergy_tot)
654 CALL almo_scf_update_ks_energy(qs_env, &
655 energy=almo_scf_env%almo_scf_energy, &
656 energy_singles_corr=denergy_tot)
657 END IF
658
659 ! compute the new KS matrix and new energy
660 IF (.NOT. almo_scf_env%perturbative_delocalization) THEN
661
662 IF (almo_scf_env%smear) THEN
663 kts_sum = sum(almo_scf_env%kTS)
664 ELSE
665 kts_sum = 0.0_dp
666 END IF
667
668 CALL almo_dm_to_almo_ks(qs_env, &
669 almo_scf_env%matrix_p, &
670 almo_scf_env%matrix_ks, &
671 energy_new, &
672 almo_scf_env%eps_filter, &
673 almo_scf_env%mat_distr_aos, &
674 smear=almo_scf_env%smear, &
675 kts_sum=kts_sum)
676 END IF
677
678 END IF ! prepare_to_exit
679
680 IF (almo_scf_env%perturbative_delocalization) THEN
681
682 ! exit after the first step if we do not need the SCF procedure
683 CALL almo_dm_to_qs_env(qs_env, almo_scf_env%matrix_p, almo_scf_env%mat_distr_aos)
684 converged = .true.
685 prepare_to_exit = .true.
686
687 ELSE ! not a perturbative treatment
688
689 energy_diff = energy_new - energy_old
690 energy_old = energy_new
691 almo_scf_env%almo_scf_energy = energy_new
692
693 t2 = m_walltime()
694 ! brief report on the current SCF loop
695 IF (unit_nr > 0) THEN
696 WRITE (unit_nr, '(T2,A,I6,F20.9,E11.3,E11.3,E11.3,F8.2)') "ALMO SCF", &
697 iscf, &
698 energy_new, energy_diff, error_norm, error_norm_0, t2 - t1
699 END IF
700 t1 = m_walltime()
701
702 END IF
703
704 IF (prepare_to_exit) EXIT
705
706 END DO ! end scf cycle
707
708 !! Print number of electrons recovered if smearing was requested
709 IF (almo_scf_env%smear) THEN
710 DO ispin = 1, nspin
711 CALL dbcsr_dot(almo_scf_env%matrix_p(ispin), almo_scf_env%matrix_s(1), density_rec)
712 IF (unit_nr > 0) THEN
713 WRITE (unit_nr, '(T2,A20,F23.10)') "Electrons recovered:", density_rec
714 END IF
715 END DO
716 END IF
717
718 IF (.NOT. converged .AND. .NOT. optimizer%early_stopping_on) THEN
719 cpabort("SCF for ALMOs on overlapping domains not converged!")
720 END IF
721
722 DO ispin = 1, nspin
723 CALL release_submatrices(submatrix_mixing_old_blk(:, ispin))
724 CALL almo_scf_diis_release(diis_env=almo_diis(ispin))
725 END DO
726 DEALLOCATE (almo_diis)
727 DEALLOCATE (submatrix_mixing_old_blk)
728
729 CALL timestop(handle)
730
731 END SUBROUTINE almo_scf_xalmo_eigensolver
732
733! **************************************************************************************************
734!> \brief Optimization of ALMOs using PCG-like minimizers
735!> \param qs_env ...
736!> \param almo_scf_env ...
737!> \param optimizer controls the optimization algorithm
738!> \param quench_t ...
739!> \param matrix_t_in ...
740!> \param matrix_t_out ...
741!> \param assume_t0_q0x - since it is extremely difficult to converge the iterative
742!> procedure using T as an optimized variable, assume
743!> T = T_0 + (1-R_0)*X and optimize X
744!> T_0 is assumed to be the zero-delocalization reference
745!> \param perturbation_only - perturbative (do not update Hamiltonian)
746!> \param special_case to reduce the overhead special cases are implemented:
747!> xalmo_case_normal - no special case (i.e. xALMOs)
748!> xalmo_case_block_diag
749!> xalmo_case_fully_deloc
750!> \par History
751!> 2011.11 created [Rustam Z Khaliullin]
752!> \author Rustam Z Khaliullin
753! **************************************************************************************************
754 SUBROUTINE almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, &
755 matrix_t_in, matrix_t_out, assume_t0_q0x, perturbation_only, &
756 special_case)
757
758 TYPE(qs_environment_type), POINTER :: qs_env
759 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
760 TYPE(optimizer_options_type), INTENT(IN) :: optimizer
761 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:), &
762 INTENT(INOUT) :: quench_t, matrix_t_in, matrix_t_out
763 LOGICAL, INTENT(IN) :: assume_t0_q0x, perturbation_only
764 INTEGER, INTENT(IN), OPTIONAL :: special_case
765
766 CHARACTER(len=*), PARAMETER :: routinen = 'almo_scf_xalmo_pcg'
767
768 CHARACTER(LEN=20) :: iter_type
769 INTEGER :: cg_iteration, dim_op, fixed_line_search_niter, handle, idim0, ielem, ispin, &
770 iteration, line_search_iteration, max_iter, my_special_case, ndomains, nmo, nspins, &
771 outer_iteration, outer_max_iter, prec_type, reim, unit_nr
772 INTEGER, ALLOCATABLE, DIMENSION(:) :: nocc
773 LOGICAL :: blissful_neglect, converged, just_started, line_search, normalize_orbitals, &
774 optimize_theta, outer_prepare_to_exit, penalty_occ_local, penalty_occ_vol, &
775 prepare_to_exit, reset_conjugator, skip_grad, use_guess
776 REAL(dp), ALLOCATABLE, DIMENSION(:) :: reim_diag, weights, z2
777 REAL(kind=dp) :: appr_sec_der, beta, denom, denom2, e0, e1, energy_coeff, energy_diff, &
778 energy_new, energy_old, eps_skip_gradients, fval, g0, g1, grad_norm, grad_norm_frob, &
779 line_search_error, localiz_coeff, localization_obj_function, next_step_size_guess, &
780 penalty_amplitude, penalty_func_new, spin_factor, step_size, t1, t2, tempreal
781 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: grad_norm_spin, &
782 penalty_occ_vol_g_prefactor, &
783 penalty_occ_vol_h_prefactor
784 TYPE(cell_type), POINTER :: cell
785 TYPE(cp_logger_type), POINTER :: logger
786 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: qs_matrix_s
787 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: op_sm_set_almo, op_sm_set_qs
788 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: ftsiginv, grad, m_sig_sqrti_ii, m_t_in_local, &
789 m_theta, prec_vv, prev_grad, prev_minus_prec_grad, prev_step, siginvtftsiginv, st, step, &
790 stsiginv_0, tempnocc, tempnocc_1, tempoccocc
791 TYPE(domain_submatrix_type), ALLOCATABLE, &
792 DIMENSION(:, :) :: bad_modes_projector_down, domain_r_down
793 TYPE(mp_comm_type) :: group
794
795 CALL timeset(routinen, handle)
796
797 my_special_case = xalmo_case_normal
798 IF (PRESENT(special_case)) my_special_case = special_case
799
800 ! get a useful output_unit
801 logger => cp_get_default_logger()
802 IF (logger%para_env%is_source()) THEN
803 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
804 ELSE
805 unit_nr = -1
806 END IF
807
808 nspins = almo_scf_env%nspins
809
810 ! if unprojected XALMOs are optimized
811 ! then we must use the "blissful_neglect" procedure
812 blissful_neglect = .false.
813 IF (my_special_case == xalmo_case_normal .AND. .NOT. assume_t0_q0x) THEN
814 blissful_neglect = .true.
815 END IF
816
817 IF (unit_nr > 0) THEN
818 WRITE (unit_nr, *)
819 SELECT CASE (my_special_case)
820 CASE (xalmo_case_block_diag)
821 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 20), &
822 " Optimization of block-diagonal ALMOs ", repeat("-", 21)
823 CASE (xalmo_case_fully_deloc)
824 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 20), &
825 " Optimization of fully delocalized MOs ", repeat("-", 20)
826 CASE (xalmo_case_normal)
827 IF (blissful_neglect) THEN
828 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 25), &
829 " LCP optimization of XALMOs ", repeat("-", 26)
830 ELSE
831 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 27), &
832 " Optimization of XALMOs ", repeat("-", 28)
833 END IF
834 END SELECT
835 WRITE (unit_nr, *)
836 WRITE (unit_nr, '(T2,A13,A6,A23,A14,A14,A9)') "Method", "Iter", &
837 "Objective Function", "Change", "Convergence", "Time"
838 WRITE (unit_nr, '(T2,A)') repeat("-", 79)
839 END IF
840
841 ! set local parameters using developer's keywords
842 ! RZK-warning: change to normal keywords later
843 optimize_theta = almo_scf_env%logical05
844 eps_skip_gradients = almo_scf_env%real01
845
846 ! penalty amplitude adjusts the strength of volume conservation
847 energy_coeff = 1.0_dp
848 localiz_coeff = 0.0_dp
849 penalty_amplitude = 0.0_dp
850 penalty_occ_vol = .false.
851 penalty_occ_local = .false.
852 normalize_orbitals = penalty_occ_vol .OR. penalty_occ_local
853 ALLOCATE (penalty_occ_vol_g_prefactor(nspins))
854 ALLOCATE (penalty_occ_vol_h_prefactor(nspins))
855 penalty_occ_vol_g_prefactor(:) = 0.0_dp
856 penalty_occ_vol_h_prefactor(:) = 0.0_dp
857 penalty_func_new = 0.0_dp
858
859 ! preconditioner control
860 prec_type = optimizer%preconditioner
861
862 ! control of the line search
863 fixed_line_search_niter = 0 ! init to zero, change when eps is small enough
864
865 IF (nspins == 1) THEN
866 spin_factor = 2.0_dp
867 ELSE
868 spin_factor = 1.0_dp
869 END IF
870
871 ALLOCATE (grad_norm_spin(nspins))
872 ALLOCATE (nocc(nspins))
873
874 ! create a local copy of matrix_t_in because
875 ! matrix_t_in and matrix_t_out can be the same matrix
876 ! we need to make sure data in matrix_t_in is intact
877 ! after we start writing to matrix_t_out
878 ALLOCATE (m_t_in_local(nspins))
879 DO ispin = 1, nspins
880 CALL dbcsr_create(m_t_in_local(ispin), &
881 template=matrix_t_in(ispin), &
882 matrix_type=dbcsr_type_no_symmetry)
883 CALL dbcsr_copy(m_t_in_local(ispin), matrix_t_in(ispin))
884 END DO
885
886 ! m_theta contains a set of variational parameters
887 ! that define one-electron orbitals (simple, projected, etc.)
888 ALLOCATE (m_theta(nspins))
889 DO ispin = 1, nspins
890 CALL dbcsr_create(m_theta(ispin), &
891 template=matrix_t_out(ispin), &
892 matrix_type=dbcsr_type_no_symmetry)
893 END DO
894
895 ! Compute localization matrices
896 IF (penalty_occ_local) THEN
897
898 CALL get_qs_env(qs_env=qs_env, &
899 matrix_s=qs_matrix_s, &
900 cell=cell)
901
902 IF (cell%orthorhombic) THEN
903 dim_op = 3
904 ELSE
905 dim_op = 6
906 END IF
907 ALLOCATE (weights(6))
908 weights = 0.0_dp
909
910 CALL initialize_weights(cell, weights)
911
912 ALLOCATE (op_sm_set_qs(2, dim_op))
913 ALLOCATE (op_sm_set_almo(2, dim_op))
914
915 DO idim0 = 1, dim_op
916 DO reim = 1, SIZE(op_sm_set_qs, 1)
917 NULLIFY (op_sm_set_qs(reim, idim0)%matrix)
918 ALLOCATE (op_sm_set_qs(reim, idim0)%matrix)
919 CALL dbcsr_copy(op_sm_set_qs(reim, idim0)%matrix, qs_matrix_s(1)%matrix, &
920 name="almo_scf_env%op_sm_"//trim(adjustl(cp_to_string(reim)))//"-"//trim(adjustl(cp_to_string(idim0))))
921 CALL dbcsr_set(op_sm_set_qs(reim, idim0)%matrix, 0.0_dp)
922 NULLIFY (op_sm_set_almo(reim, idim0)%matrix)
923 ALLOCATE (op_sm_set_almo(reim, idim0)%matrix)
924 CALL dbcsr_copy(op_sm_set_almo(reim, idim0)%matrix, almo_scf_env%matrix_s(1), &
925 name="almo_scf_env%op_sm_"//trim(adjustl(cp_to_string(reim)))//"-"//trim(adjustl(cp_to_string(idim0))))
926 CALL dbcsr_set(op_sm_set_almo(reim, idim0)%matrix, 0.0_dp)
927 END DO
928 END DO
929
930 CALL compute_berry_operator(qs_env, cell, op_sm_set_qs, dim_op)
931
932 !CALL matrix_qs_to_almo(op_sm_set_qs, op_sm_set_almo, almo_scf_env%mat_distr_aos)
933
934 END IF
935
936 ! create initial guess from the initial orbitals
937 CALL xalmo_initial_guess(m_guess=m_theta, &
938 m_t_in=m_t_in_local, &
939 m_t0=almo_scf_env%matrix_t_blk, &
940 m_quench_t=quench_t, &
941 m_overlap=almo_scf_env%matrix_s(1), &
942 m_sigma_tmpl=almo_scf_env%matrix_sigma_inv, &
943 nspins=nspins, &
944 xalmo_history=almo_scf_env%xalmo_history, &
945 assume_t0_q0x=assume_t0_q0x, &
946 optimize_theta=optimize_theta, &
947 envelope_amplitude=almo_scf_env%envelope_amplitude, &
948 eps_filter=almo_scf_env%eps_filter, &
949 order_lanczos=almo_scf_env%order_lanczos, &
950 eps_lanczos=almo_scf_env%eps_lanczos, &
951 max_iter_lanczos=almo_scf_env%max_iter_lanczos, &
952 nocc_of_domain=almo_scf_env%nocc_of_domain)
953
954 ndomains = almo_scf_env%ndomains
955 ALLOCATE (domain_r_down(ndomains, nspins))
956 CALL init_submatrices(domain_r_down)
957 ALLOCATE (bad_modes_projector_down(ndomains, nspins))
958 CALL init_submatrices(bad_modes_projector_down)
959
960 ALLOCATE (prec_vv(nspins))
961 ALLOCATE (siginvtftsiginv(nspins))
962 ALLOCATE (stsiginv_0(nspins))
963 ALLOCATE (ftsiginv(nspins))
964 ALLOCATE (st(nspins))
965 ALLOCATE (prev_grad(nspins))
966 ALLOCATE (grad(nspins))
967 ALLOCATE (prev_step(nspins))
968 ALLOCATE (step(nspins))
969 ALLOCATE (prev_minus_prec_grad(nspins))
970 ALLOCATE (m_sig_sqrti_ii(nspins))
971 ALLOCATE (tempnocc(nspins))
972 ALLOCATE (tempnocc_1(nspins))
973 ALLOCATE (tempoccocc(nspins))
974 DO ispin = 1, nspins
975
976 ! init temporary storage
977 CALL dbcsr_create(prec_vv(ispin), &
978 template=almo_scf_env%matrix_ks(ispin), &
979 matrix_type=dbcsr_type_no_symmetry)
980 CALL dbcsr_create(siginvtftsiginv(ispin), &
981 template=almo_scf_env%matrix_sigma(ispin), &
982 matrix_type=dbcsr_type_no_symmetry)
983 CALL dbcsr_create(stsiginv_0(ispin), &
984 template=matrix_t_out(ispin), &
985 matrix_type=dbcsr_type_no_symmetry)
986 CALL dbcsr_create(ftsiginv(ispin), &
987 template=matrix_t_out(ispin), &
988 matrix_type=dbcsr_type_no_symmetry)
989 CALL dbcsr_create(st(ispin), &
990 template=matrix_t_out(ispin), &
991 matrix_type=dbcsr_type_no_symmetry)
992 CALL dbcsr_create(prev_grad(ispin), &
993 template=matrix_t_out(ispin), &
994 matrix_type=dbcsr_type_no_symmetry)
995 CALL dbcsr_create(grad(ispin), &
996 template=matrix_t_out(ispin), &
997 matrix_type=dbcsr_type_no_symmetry)
998 CALL dbcsr_create(prev_step(ispin), &
999 template=matrix_t_out(ispin), &
1000 matrix_type=dbcsr_type_no_symmetry)
1001 CALL dbcsr_create(step(ispin), &
1002 template=matrix_t_out(ispin), &
1003 matrix_type=dbcsr_type_no_symmetry)
1004 CALL dbcsr_create(prev_minus_prec_grad(ispin), &
1005 template=matrix_t_out(ispin), &
1006 matrix_type=dbcsr_type_no_symmetry)
1007 CALL dbcsr_create(m_sig_sqrti_ii(ispin), &
1008 template=almo_scf_env%matrix_sigma_inv(ispin), &
1009 matrix_type=dbcsr_type_no_symmetry)
1010 CALL dbcsr_create(tempnocc(ispin), &
1011 template=matrix_t_out(ispin), &
1012 matrix_type=dbcsr_type_no_symmetry)
1013 CALL dbcsr_create(tempnocc_1(ispin), &
1014 template=matrix_t_out(ispin), &
1015 matrix_type=dbcsr_type_no_symmetry)
1016 CALL dbcsr_create(tempoccocc(ispin), &
1017 template=almo_scf_env%matrix_sigma_inv(ispin), &
1018 matrix_type=dbcsr_type_no_symmetry)
1019
1020 CALL dbcsr_set(step(ispin), 0.0_dp)
1021 CALL dbcsr_set(prev_step(ispin), 0.0_dp)
1022
1023 CALL dbcsr_get_info(almo_scf_env%matrix_sigma_inv(ispin), &
1024 nfullrows_total=nocc(ispin))
1025
1026 ! invert S domains if necessary
1027 ! Note: domains for alpha and beta electrons might be different
1028 ! that is why the inversion of the AO overlap is inside the spin loop
1029 IF (my_special_case == xalmo_case_normal) THEN
1030 CALL construct_domain_s_inv( &
1031 matrix_s=almo_scf_env%matrix_s(1), &
1032 subm_s_inv=almo_scf_env%domain_s_inv(:, ispin), &
1033 dpattern=quench_t(ispin), &
1034 map=almo_scf_env%domain_map(ispin), &
1035 node_of_domain=almo_scf_env%cpu_of_domain)
1036
1037 CALL construct_domain_s_sqrt( &
1038 matrix_s=almo_scf_env%matrix_s(1), &
1039 subm_s_sqrt=almo_scf_env%domain_s_sqrt(:, ispin), &
1040 subm_s_sqrt_inv=almo_scf_env%domain_s_sqrt_inv(:, ispin), &
1041 dpattern=almo_scf_env%quench_t(ispin), &
1042 map=almo_scf_env%domain_map(ispin), &
1043 node_of_domain=almo_scf_env%cpu_of_domain)
1044
1045 END IF
1046
1047 IF (assume_t0_q0x) THEN
1048
1049 ! save S.T_0.siginv_0
1050 IF (my_special_case == xalmo_case_fully_deloc) THEN
1051 CALL dbcsr_multiply("N", "N", 1.0_dp, &
1052 almo_scf_env%matrix_s(1), &
1053 almo_scf_env%matrix_t_blk(ispin), &
1054 0.0_dp, st(ispin), &
1055 filter_eps=almo_scf_env%eps_filter)
1056 CALL dbcsr_multiply("N", "N", 1.0_dp, &
1057 st(ispin), &
1058 almo_scf_env%matrix_sigma_inv_0deloc(ispin), &
1059 0.0_dp, stsiginv_0(ispin), &
1060 filter_eps=almo_scf_env%eps_filter)
1061 END IF
1062
1063 ! construct domain-projector
1064 IF (my_special_case == xalmo_case_normal) THEN
1065 CALL construct_domain_r_down( &
1066 matrix_t=almo_scf_env%matrix_t_blk(ispin), &
1067 matrix_sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), &
1068 matrix_s=almo_scf_env%matrix_s(1), &
1069 subm_r_down=domain_r_down(:, ispin), &
1070 dpattern=quench_t(ispin), &
1071 map=almo_scf_env%domain_map(ispin), &
1072 node_of_domain=almo_scf_env%cpu_of_domain, &
1073 filter_eps=almo_scf_env%eps_filter)
1074 END IF
1075
1076 END IF ! assume_t0_q0x
1077
1078 ! localization functional
1079 IF (penalty_occ_local) THEN
1080
1081 ! compute S.R0.B.R0.S
1082 CALL dbcsr_multiply("N", "N", 1.0_dp, &
1083 almo_scf_env%matrix_s(1), &
1084 matrix_t_in(ispin), &
1085 0.0_dp, tempnocc(ispin), &
1086 filter_eps=almo_scf_env%eps_filter)
1087 CALL dbcsr_multiply("N", "N", 1.0_dp, &
1088 tempnocc(ispin), &
1089 almo_scf_env%matrix_sigma_inv(ispin), &
1090 0.0_dp, tempnocc_1(ispin), &
1091 filter_eps=almo_scf_env%eps_filter)
1092
1093 DO idim0 = 1, SIZE(op_sm_set_qs, 2) ! this loop is over miller ind
1094 DO reim = 1, SIZE(op_sm_set_qs, 1) ! this loop is over Re/Im
1095
1096 CALL matrix_qs_to_almo(op_sm_set_qs(reim, idim0)%matrix, &
1097 op_sm_set_almo(reim, idim0)%matrix, almo_scf_env%mat_distr_aos)
1098
1099 CALL dbcsr_multiply("N", "N", 1.0_dp, &
1100 op_sm_set_almo(reim, idim0)%matrix, &
1101 matrix_t_in(ispin), &
1102 0.0_dp, tempnocc(ispin), &
1103 filter_eps=almo_scf_env%eps_filter)
1104
1105 CALL dbcsr_multiply("T", "N", 1.0_dp, &
1106 matrix_t_in(ispin), &
1107 tempnocc(ispin), &
1108 0.0_dp, tempoccocc(ispin), &
1109 filter_eps=almo_scf_env%eps_filter)
1110
1111 CALL dbcsr_multiply("N", "N", 1.0_dp, &
1112 tempnocc_1(ispin), &
1113 tempoccocc(ispin), &
1114 0.0_dp, tempnocc(ispin), &
1115 filter_eps=almo_scf_env%eps_filter)
1116
1117 CALL dbcsr_multiply("N", "T", 1.0_dp, &
1118 tempnocc(ispin), &
1119 tempnocc_1(ispin), &
1120 0.0_dp, op_sm_set_almo(reim, idim0)%matrix, &
1121 filter_eps=almo_scf_env%eps_filter)
1122
1123 END DO
1124 END DO ! end loop over idim0
1125
1126 END IF !penalty_occ_local
1127
1128 END DO ! ispin
1129
1130 ! start the outer SCF loop
1131 outer_max_iter = optimizer%max_iter_outer_loop
1132 outer_prepare_to_exit = .false.
1133 outer_iteration = 0
1134 grad_norm = 0.0_dp
1135 grad_norm_frob = 0.0_dp
1136 use_guess = .false.
1137
1138 DO
1139
1140 ! start the inner SCF loop
1141 max_iter = optimizer%max_iter
1142 prepare_to_exit = .false.
1143 line_search = .false.
1144 converged = .false.
1145 iteration = 0
1146 cg_iteration = 0
1147 line_search_iteration = 0
1148 energy_new = 0.0_dp
1149 energy_old = 0.0_dp
1150 energy_diff = 0.0_dp
1151 localization_obj_function = 0.0_dp
1152 line_search_error = 0.0_dp
1153
1154 t1 = m_walltime()
1155
1156 DO
1157
1158 just_started = (iteration == 0) .AND. (outer_iteration == 0)
1159
1160 CALL main_var_to_xalmos_and_loss_func( &
1161 almo_scf_env=almo_scf_env, &
1162 qs_env=qs_env, &
1163 m_main_var_in=m_theta, &
1164 m_t_out=matrix_t_out, &
1165 m_sig_sqrti_ii_out=m_sig_sqrti_ii, &
1166 energy_out=energy_new, &
1167 penalty_out=penalty_func_new, &
1168 m_ftsiginv_out=ftsiginv, &
1169 m_siginvtftsiginv_out=siginvtftsiginv, &
1170 m_st_out=st, &
1171 m_stsiginv0_in=stsiginv_0, &
1172 m_quench_t_in=quench_t, &
1173 domain_r_down_in=domain_r_down, &
1174 assume_t0_q0x=assume_t0_q0x, &
1175 just_started=just_started, &
1176 optimize_theta=optimize_theta, &
1177 normalize_orbitals=normalize_orbitals, &
1178 perturbation_only=perturbation_only, &
1179 do_penalty=penalty_occ_vol, &
1180 special_case=my_special_case)
1181 IF (penalty_occ_vol) THEN
1182 ! this is not pure energy anymore
1183 energy_new = energy_new + penalty_func_new
1184 END IF
1185 DO ispin = 1, nspins
1186 IF (penalty_occ_vol) THEN
1187 penalty_occ_vol_g_prefactor(ispin) = &
1188 -2.0_dp*penalty_amplitude*spin_factor*nocc(ispin)
1189 penalty_occ_vol_h_prefactor(ispin) = 0.0_dp
1190 END IF
1191 END DO
1192
1193 localization_obj_function = 0.0_dp
1194 ! RZK-warning: This block must be combined with the loss function
1195 IF (penalty_occ_local) THEN
1196 DO ispin = 1, nspins
1197
1198 ! LzL insert localization penalty
1199 localization_obj_function = 0.0_dp
1200 CALL dbcsr_get_info(almo_scf_env%matrix_sigma_inv(ispin), nfullrows_total=nmo)
1201 ALLOCATE (z2(nmo))
1202 ALLOCATE (reim_diag(nmo))
1203
1204 CALL dbcsr_get_info(tempoccocc(ispin), group=group)
1205
1206 DO idim0 = 1, SIZE(op_sm_set_qs, 2) ! this loop is over miller ind
1207
1208 z2(:) = 0.0_dp
1209
1210 DO reim = 1, SIZE(op_sm_set_qs, 1) ! this loop is over Re/Im
1211
1212 CALL dbcsr_multiply("N", "N", 1.0_dp, &
1213 op_sm_set_almo(reim, idim0)%matrix, &
1214 matrix_t_out(ispin), &
1215 0.0_dp, tempnocc(ispin), &
1216 filter_eps=almo_scf_env%eps_filter)
1217 !warning - save time by computing only the diagonal elements
1218 CALL dbcsr_multiply("T", "N", 1.0_dp, &
1219 matrix_t_out(ispin), &
1220 tempnocc(ispin), &
1221 0.0_dp, tempoccocc(ispin), &
1222 filter_eps=almo_scf_env%eps_filter)
1223
1224 reim_diag = 0.0_dp
1225 CALL dbcsr_get_diag(tempoccocc(ispin), reim_diag)
1226 CALL group%sum(reim_diag)
1227 z2(:) = z2(:) + reim_diag(:)*reim_diag(:)
1228
1229 END DO
1230
1231 DO ielem = 1, nmo
1232 SELECT CASE (2) ! allows for selection of different spread functionals
1233 CASE (1) ! functional = -W_I * log( |z_I|^2 )
1234 fval = -weights(idim0)*log(abs(z2(ielem)))
1235 CASE (2) ! functional = W_I * ( 1 - |z_I|^2 )
1236 fval = weights(idim0) - weights(idim0)*abs(z2(ielem))
1237 CASE (3) ! functional = W_I * ( 1 - |z_I| )
1238 fval = weights(idim0) - weights(idim0)*sqrt(abs(z2(ielem)))
1239 END SELECT
1240 localization_obj_function = localization_obj_function + fval
1241 END DO
1242
1243 END DO ! end loop over idim0
1244
1245 DEALLOCATE (z2)
1246 DEALLOCATE (reim_diag)
1247
1248 energy_new = energy_new + localiz_coeff*localization_obj_function
1249
1250 END DO ! ispin
1251 END IF ! penalty_occ_local
1252
1253 DO ispin = 1, nspins
1254
1255 IF (just_started .AND. almo_mathematica) THEN
1256 cpwarn_if(ispin > 1, "Mathematica files will be overwritten")
1257 CALL print_mathematica_matrix(almo_scf_env%matrix_s(1), "matrixS.dat")
1258 CALL print_mathematica_matrix(almo_scf_env%matrix_ks(ispin), "matrixF.dat")
1259 CALL print_mathematica_matrix(matrix_t_out(ispin), "matrixT.dat")
1260 CALL print_mathematica_matrix(quench_t(ispin), "matrixQ.dat")
1261 END IF
1262
1263 ! save the previous gradient to compute beta
1264 ! do it only if the previous grad was computed
1265 ! for .NOT.line_search
1266 IF (line_search_iteration == 0 .AND. iteration /= 0) THEN
1267 CALL dbcsr_copy(prev_grad(ispin), grad(ispin))
1268 END IF
1269
1270 END DO ! ispin
1271
1272 ! compute the energy gradient if necessary
1273 skip_grad = (iteration > 0 .AND. &
1274 fixed_line_search_niter /= 0 .AND. &
1275 line_search_iteration /= fixed_line_search_niter)
1276
1277 IF (.NOT. skip_grad) THEN
1278
1279 DO ispin = 1, nspins
1280
1281 CALL compute_gradient( &
1282 m_grad_out=grad(ispin), &
1283 m_ks=almo_scf_env%matrix_ks(ispin), &
1284 m_s=almo_scf_env%matrix_s(1), &
1285 m_t=matrix_t_out(ispin), &
1286 m_t0=almo_scf_env%matrix_t_blk(ispin), &
1287 m_siginv=almo_scf_env%matrix_sigma_inv(ispin), &
1288 m_quench_t=quench_t(ispin), &
1289 m_ftsiginv=ftsiginv(ispin), &
1290 m_siginvtftsiginv=siginvtftsiginv(ispin), &
1291 m_st=st(ispin), &
1292 m_stsiginv0=stsiginv_0(ispin), &
1293 m_theta=m_theta(ispin), &
1294 m_sig_sqrti_ii=m_sig_sqrti_ii(ispin), &
1295 domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), &
1296 domain_r_down=domain_r_down(:, ispin), &
1297 cpu_of_domain=almo_scf_env%cpu_of_domain, &
1298 domain_map=almo_scf_env%domain_map(ispin), &
1299 assume_t0_q0x=assume_t0_q0x, &
1300 optimize_theta=optimize_theta, &
1301 normalize_orbitals=normalize_orbitals, &
1302 penalty_occ_vol=penalty_occ_vol, &
1303 penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(ispin), &
1304 envelope_amplitude=almo_scf_env%envelope_amplitude, &
1305 eps_filter=almo_scf_env%eps_filter, &
1306 spin_factor=spin_factor, &
1307 special_case=my_special_case, &
1308 penalty_occ_local=penalty_occ_local, &
1309 op_sm_set=op_sm_set_almo, &
1310 weights=weights, &
1311 energy_coeff=energy_coeff, &
1312 localiz_coeff=localiz_coeff)
1313
1314 END DO ! ispin
1315
1316 END IF ! skip_grad
1317
1318 ! if unprojected XALMOs are optimized then compute both
1319 ! HessianInv/preconditioner and the "bad-mode" projector
1320
1321 IF (blissful_neglect) THEN
1322 DO ispin = 1, nspins
1323 !compute the prec only for the first step,
1324 !but project the gradient every step
1325 IF (iteration == 0) THEN
1326 CALL compute_preconditioner( &
1327 domain_prec_out=almo_scf_env%domain_preconditioner(:, ispin), &
1328 bad_modes_projector_down_out=bad_modes_projector_down(:, ispin), &
1329 m_prec_out=prec_vv(ispin), &
1330 m_ks=almo_scf_env%matrix_ks(ispin), &
1331 m_s=almo_scf_env%matrix_s(1), &
1332 m_siginv=almo_scf_env%matrix_sigma_inv(ispin), &
1333 m_quench_t=quench_t(ispin), &
1334 m_ftsiginv=ftsiginv(ispin), &
1335 m_siginvtftsiginv=siginvtftsiginv(ispin), &
1336 m_st=st(ispin), &
1337 para_env=almo_scf_env%para_env, &
1338 blacs_env=almo_scf_env%blacs_env, &
1339 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), &
1340 domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), &
1341 domain_s_inv_half=almo_scf_env%domain_s_sqrt_inv(:, ispin), &
1342 domain_s_half=almo_scf_env%domain_s_sqrt(:, ispin), &
1343 domain_r_down=domain_r_down(:, ispin), &
1344 cpu_of_domain=almo_scf_env%cpu_of_domain, &
1345 domain_map=almo_scf_env%domain_map(ispin), &
1346 assume_t0_q0x=assume_t0_q0x, &
1347 penalty_occ_vol=penalty_occ_vol, &
1348 penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(ispin), &
1349 eps_filter=almo_scf_env%eps_filter, &
1350 neg_thr=optimizer%neglect_threshold, &
1351 spin_factor=spin_factor, &
1352 skip_inversion=.false., &
1353 special_case=my_special_case)
1354 END IF
1355 ! remove bad modes from the gradient
1356 CALL apply_domain_operators( &
1357 matrix_in=grad(ispin), &
1358 matrix_out=grad(ispin), &
1359 operator1=almo_scf_env%domain_s_inv(:, ispin), &
1360 operator2=bad_modes_projector_down(:, ispin), &
1361 dpattern=quench_t(ispin), &
1362 map=almo_scf_env%domain_map(ispin), &
1363 node_of_domain=almo_scf_env%cpu_of_domain, &
1364 my_action=1, &
1365 filter_eps=almo_scf_env%eps_filter)
1366
1367 END DO ! ispin
1368
1369 END IF ! blissful neglect
1370
1371 ! check convergence and other exit criteria
1372 DO ispin = 1, nspins
1373 grad_norm_spin(ispin) = dbcsr_maxabs(grad(ispin))
1374 END DO ! ispin
1375 grad_norm = maxval(grad_norm_spin)
1376
1377 converged = (grad_norm <= optimizer%eps_error)
1378 IF (converged .OR. (iteration >= max_iter)) THEN
1379 prepare_to_exit = .true.
1380 END IF
1381 ! if early stopping is on do at least one iteration
1382 IF (optimizer%early_stopping_on .AND. just_started) THEN
1383 prepare_to_exit = .false.
1384 END IF
1385
1386 IF (grad_norm < almo_scf_env%eps_prev_guess) THEN
1387 use_guess = .true.
1388 END IF
1389
1390 ! it is not time to exit just yet
1391 IF (.NOT. prepare_to_exit) THEN
1392
1393 ! check the gradient along the step direction
1394 ! and decide whether to switch to the line-search mode
1395 ! do not do this in the first iteration
1396 IF (iteration /= 0) THEN
1397
1398 IF (fixed_line_search_niter == 0) THEN
1399
1400 ! enforce at least one line search
1401 ! without even checking the error
1402 IF (.NOT. line_search) THEN
1403
1404 line_search = .true.
1405 line_search_iteration = line_search_iteration + 1
1406
1407 ELSE
1408
1409 ! check the line-search error and decide whether to
1410 ! change the direction
1411 line_search_error = 0.0_dp
1412 denom = 0.0_dp
1413 denom2 = 0.0_dp
1414
1415 DO ispin = 1, nspins
1416
1417 CALL dbcsr_dot(grad(ispin), step(ispin), tempreal)
1418 line_search_error = line_search_error + tempreal
1419 CALL dbcsr_dot(grad(ispin), grad(ispin), tempreal)
1420 denom = denom + tempreal
1421 CALL dbcsr_dot(step(ispin), step(ispin), tempreal)
1422 denom2 = denom2 + tempreal
1423
1424 END DO ! ispin
1425
1426 ! cosine of the angle between the step and grad
1427 ! (must be close to zero at convergence)
1428 line_search_error = line_search_error/sqrt(denom)/sqrt(denom2)
1429
1430 IF (abs(line_search_error) > optimizer%lin_search_eps_error) THEN
1431 line_search = .true.
1432 line_search_iteration = line_search_iteration + 1
1433 ELSE
1434 line_search = .false.
1435 line_search_iteration = 0
1436 IF (grad_norm < eps_skip_gradients) THEN
1437 fixed_line_search_niter = abs(almo_scf_env%integer04)
1438 END IF
1439 END IF
1440
1441 END IF
1442
1443 ELSE ! decision for fixed_line_search_niter
1444
1445 IF (.NOT. line_search) THEN
1446 line_search = .true.
1447 line_search_iteration = line_search_iteration + 1
1448 ELSE
1449 IF (line_search_iteration == fixed_line_search_niter) THEN
1450 line_search = .false.
1451 line_search_iteration = 0
1452 line_search_iteration = line_search_iteration + 1
1453 END IF
1454 END IF
1455
1456 END IF ! fixed_line_search_niter fork
1457
1458 END IF ! iteration.ne.0
1459
1460 IF (line_search) THEN
1461 energy_diff = 0.0_dp
1462 ELSE
1463 energy_diff = energy_new - energy_old
1464 energy_old = energy_new
1465 END IF
1466
1467 ! update the step direction
1468 IF (.NOT. line_search) THEN
1469
1470 cg_iteration = cg_iteration + 1
1471
1472 ! save the previous step
1473 DO ispin = 1, nspins
1474 CALL dbcsr_copy(prev_step(ispin), step(ispin))
1475 END DO ! ispin
1476
1477 ! compute the new step (apply preconditioner if available)
1478 SELECT CASE (prec_type)
1479 CASE (xalmo_prec_full)
1480
1481 ! solving approximate Newton eq in the full (linearized) space
1482 CALL newton_grad_to_step( &
1483 optimizer=almo_scf_env%opt_xalmo_newton_pcg_solver, &
1484 m_grad=grad(:), &
1485 m_delta=step(:), &
1486 m_s=almo_scf_env%matrix_s(:), &
1487 m_ks=almo_scf_env%matrix_ks(:), &
1488 m_siginv=almo_scf_env%matrix_sigma_inv(:), &
1489 m_quench_t=quench_t(:), &
1490 m_ftsiginv=ftsiginv(:), &
1491 m_siginvtftsiginv=siginvtftsiginv(:), &
1492 m_st=st(:), &
1493 m_t=matrix_t_out(:), &
1494 m_sig_sqrti_ii=m_sig_sqrti_ii(:), &
1495 domain_s_inv=almo_scf_env%domain_s_inv(:, :), &
1496 domain_r_down=domain_r_down(:, :), &
1497 domain_map=almo_scf_env%domain_map(:), &
1498 cpu_of_domain=almo_scf_env%cpu_of_domain, &
1499 nocc_of_domain=almo_scf_env%nocc_of_domain(:, :), &
1500 para_env=almo_scf_env%para_env, &
1501 blacs_env=almo_scf_env%blacs_env, &
1502 eps_filter=almo_scf_env%eps_filter, &
1503 optimize_theta=optimize_theta, &
1504 penalty_occ_vol=penalty_occ_vol, &
1505 normalize_orbitals=normalize_orbitals, &
1506 penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(:), &
1507 penalty_occ_vol_pf2=penalty_occ_vol_h_prefactor(:), &
1508 special_case=my_special_case &
1509 )
1510
1511 CASE (xalmo_prec_domain)
1512
1513 ! compute and invert preconditioner?
1514 IF (.NOT. blissful_neglect .AND. &
1515 ((just_started .AND. perturbation_only) .OR. &
1516 (iteration == 0 .AND. (.NOT. perturbation_only))) &
1517 ) THEN
1518
1519 ! computing preconditioner
1520 DO ispin = 1, nspins
1521 CALL compute_preconditioner( &
1522 domain_prec_out=almo_scf_env%domain_preconditioner(:, ispin), &
1523 m_prec_out=prec_vv(ispin), &
1524 m_ks=almo_scf_env%matrix_ks(ispin), &
1525 m_s=almo_scf_env%matrix_s(1), &
1526 m_siginv=almo_scf_env%matrix_sigma_inv(ispin), &
1527 m_quench_t=quench_t(ispin), &
1528 m_ftsiginv=ftsiginv(ispin), &
1529 m_siginvtftsiginv=siginvtftsiginv(ispin), &
1530 m_st=st(ispin), &
1531 para_env=almo_scf_env%para_env, &
1532 blacs_env=almo_scf_env%blacs_env, &
1533 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), &
1534 domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), &
1535 domain_r_down=domain_r_down(:, ispin), &
1536 cpu_of_domain=almo_scf_env%cpu_of_domain, &
1537 domain_map=almo_scf_env%domain_map(ispin), &
1538 assume_t0_q0x=assume_t0_q0x, &
1539 penalty_occ_vol=penalty_occ_vol, &
1540 penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(ispin), &
1541 eps_filter=almo_scf_env%eps_filter, &
1542 neg_thr=0.5_dp, &
1543 spin_factor=spin_factor, &
1544 skip_inversion=.false., &
1545 special_case=my_special_case)
1546 END DO ! ispin
1547 END IF ! compute_prec
1548
1549 IF (my_special_case == xalmo_case_block_diag .OR. &
1550 my_special_case == xalmo_case_fully_deloc) THEN
1551
1552 DO ispin = 1, nspins
1553
1554 CALL dbcsr_multiply("N", "N", -1.0_dp, &
1555 prec_vv(ispin), &
1556 grad(ispin), &
1557 0.0_dp, step(ispin), &
1558 filter_eps=almo_scf_env%eps_filter)
1559
1560 END DO ! ispin
1561
1562 ELSE
1563
1564 !!! RZK-warning Currently for non-theta only
1565 IF (optimize_theta) THEN
1566 cpabort("theta is NYI")
1567 END IF
1568
1569 DO ispin = 1, nspins
1570
1571 CALL apply_domain_operators( &
1572 matrix_in=grad(ispin), &
1573 matrix_out=step(ispin), &
1574 operator1=almo_scf_env%domain_preconditioner(:, ispin), &
1575 dpattern=quench_t(ispin), &
1576 map=almo_scf_env%domain_map(ispin), &
1577 node_of_domain=almo_scf_env%cpu_of_domain, &
1578 my_action=0, &
1579 filter_eps=almo_scf_env%eps_filter)
1580 CALL dbcsr_scale(step(ispin), -1.0_dp)
1581
1582 END DO ! ispin
1583
1584 END IF ! special case
1585
1586 CASE (xalmo_prec_zero)
1587
1588 ! no preconditioner
1589 DO ispin = 1, nspins
1590
1591 CALL dbcsr_copy(step(ispin), grad(ispin))
1592 CALL dbcsr_scale(step(ispin), -1.0_dp)
1593
1594 END DO ! ispin
1595
1596 END SELECT ! preconditioner type fork
1597
1598 ! check whether we need to reset conjugate directions
1599 IF (iteration == 0) THEN
1600 reset_conjugator = .true.
1601 END IF
1602
1603 ! compute the conjugation coefficient - beta
1604 IF (.NOT. reset_conjugator) THEN
1605
1606 CALL compute_cg_beta( &
1607 beta=beta, &
1608 reset_conjugator=reset_conjugator, &
1609 conjugator=optimizer%conjugator, &
1610 grad=grad(:), &
1611 prev_grad=prev_grad(:), &
1612 step=step(:), &
1613 prev_step=prev_step(:), &
1614 prev_minus_prec_grad=prev_minus_prec_grad(:) &
1615 )
1616
1617 END IF
1618
1619 IF (reset_conjugator) THEN
1620
1621 beta = 0.0_dp
1622 IF (unit_nr > 0 .AND. (.NOT. just_started)) THEN
1623 WRITE (unit_nr, '(T2,A35)') "Re-setting conjugator to zero"
1624 END IF
1625 reset_conjugator = .false.
1626
1627 END IF
1628
1629 ! save the preconditioned gradient (useful for beta)
1630 DO ispin = 1, nspins
1631
1632 CALL dbcsr_copy(prev_minus_prec_grad(ispin), step(ispin))
1633
1634 ! conjugate the step direction
1635 CALL dbcsr_add(step(ispin), prev_step(ispin), 1.0_dp, beta)
1636
1637 END DO ! ispin
1638
1639 END IF ! update the step direction
1640
1641 ! estimate the step size
1642 IF (.NOT. line_search) THEN
1643 ! we just changed the direction and
1644 ! we have only E and grad from the current step
1645 ! it is not enouhg to compute step_size - just guess it
1646 e0 = energy_new
1647 g0 = 0.0_dp
1648 DO ispin = 1, nspins
1649 CALL dbcsr_dot(grad(ispin), step(ispin), tempreal)
1650 g0 = g0 + tempreal
1651 END DO ! ispin
1652 IF (iteration == 0) THEN
1653 step_size = optimizer%lin_search_step_size_guess
1654 ELSE
1655 IF (next_step_size_guess <= 0.0_dp) THEN
1656 step_size = optimizer%lin_search_step_size_guess
1657 ELSE
1658 ! take the last value
1659 step_size = next_step_size_guess*1.05_dp
1660 END IF
1661 END IF
1662 next_step_size_guess = step_size
1663 ELSE
1664 IF (fixed_line_search_niter == 0) THEN
1665 e1 = energy_new
1666 g1 = 0.0_dp
1667 DO ispin = 1, nspins
1668 CALL dbcsr_dot(grad(ispin), step(ispin), tempreal)
1669 g1 = g1 + tempreal
1670 END DO ! ispin
1671 ! we have accumulated some points along this direction
1672 ! use only the most recent g0 (quadratic approximation)
1673 appr_sec_der = (g1 - g0)/step_size
1674 step_size = -g1/appr_sec_der
1675 e0 = e1
1676 g0 = g1
1677 ELSE
1678 ! use e0, g0 and e1 to compute g1 and make a step
1679 ! if the next iteration is also line_search
1680 ! use e1 and the calculated g1 as e0 and g0
1681 e1 = energy_new
1682 appr_sec_der = 2.0*((e1 - e0)/step_size - g0)/step_size
1683 g1 = appr_sec_der*step_size + g0
1684 step_size = -g1/appr_sec_der
1685 e0 = e1
1686 g0 = g1
1687 END IF
1688 next_step_size_guess = next_step_size_guess + step_size
1689 END IF
1690
1691 ! update theta
1692 DO ispin = 1, nspins
1693 CALL dbcsr_add(m_theta(ispin), step(ispin), 1.0_dp, step_size)
1694 END DO ! ispin
1695
1696 END IF ! not.prepare_to_exit
1697
1698 IF (line_search) THEN
1699 iter_type = "LS"
1700 ELSE
1701 iter_type = "CG"
1702 END IF
1703
1704 t2 = m_walltime()
1705 IF (unit_nr > 0) THEN
1706 iter_type = trim("ALMO SCF "//iter_type)
1707 WRITE (unit_nr, '(T2,A13,I6,F23.10,E14.5,F14.9,F9.2)') &
1708 iter_type, iteration, &
1709 energy_new, energy_diff, grad_norm, &
1710 t2 - t1
1711 IF (penalty_occ_local .OR. penalty_occ_vol) THEN
1712 WRITE (unit_nr, '(T2,A25,F23.10)') &
1713 "Energy component:", (energy_new - penalty_func_new - localization_obj_function)
1714 END IF
1715 IF (penalty_occ_local) THEN
1716 WRITE (unit_nr, '(T2,A25,F23.10)') &
1717 "Localization component:", localization_obj_function
1718 END IF
1719 IF (penalty_occ_vol) THEN
1720 WRITE (unit_nr, '(T2,A25,F23.10)') &
1721 "Penalty component:", penalty_func_new
1722 END IF
1723 END IF
1724
1725 IF (my_special_case == xalmo_case_block_diag) THEN
1726 IF (penalty_occ_vol) THEN
1727 almo_scf_env%almo_scf_energy = energy_new - penalty_func_new - localization_obj_function
1728 ELSE
1729 almo_scf_env%almo_scf_energy = energy_new - localization_obj_function
1730 END IF
1731 END IF
1732
1733 t1 = m_walltime()
1734
1735 iteration = iteration + 1
1736 IF (prepare_to_exit) EXIT
1737
1738 END DO ! inner SCF loop
1739
1740 IF (converged .OR. (outer_iteration >= outer_max_iter)) THEN
1741 outer_prepare_to_exit = .true.
1742 END IF
1743
1744 outer_iteration = outer_iteration + 1
1745 IF (outer_prepare_to_exit) EXIT
1746
1747 END DO ! outer SCF loop
1748
1749 DO ispin = 1, nspins
1750 IF (converged .AND. almo_mathematica) THEN
1751 cpwarn_if(ispin > 1, "Mathematica files will be overwritten")
1752 CALL print_mathematica_matrix(matrix_t_out(ispin), "matrixTf.dat")
1753 END IF
1754 END DO ! ispin
1755
1756 ! post SCF-loop calculations
1757 IF (converged) THEN
1758
1759 CALL wrap_up_xalmo_scf( &
1760 qs_env=qs_env, &
1761 almo_scf_env=almo_scf_env, &
1762 perturbation_in=perturbation_only, &
1763 m_xalmo_in=matrix_t_out, &
1764 m_quench_in=quench_t, &
1765 energy_inout=energy_new)
1766
1767 END IF ! if converged
1768
1769 DO ispin = 1, nspins
1770 CALL dbcsr_release(prec_vv(ispin))
1771 CALL dbcsr_release(stsiginv_0(ispin))
1772 CALL dbcsr_release(st(ispin))
1773 CALL dbcsr_release(ftsiginv(ispin))
1774 CALL dbcsr_release(siginvtftsiginv(ispin))
1775 CALL dbcsr_release(prev_grad(ispin))
1776 CALL dbcsr_release(prev_step(ispin))
1777 CALL dbcsr_release(grad(ispin))
1778 CALL dbcsr_release(step(ispin))
1779 CALL dbcsr_release(prev_minus_prec_grad(ispin))
1780 CALL dbcsr_release(m_theta(ispin))
1781 CALL dbcsr_release(m_t_in_local(ispin))
1782 CALL dbcsr_release(m_sig_sqrti_ii(ispin))
1783 CALL release_submatrices(domain_r_down(:, ispin))
1784 CALL release_submatrices(bad_modes_projector_down(:, ispin))
1785 CALL dbcsr_release(tempnocc(ispin))
1786 CALL dbcsr_release(tempnocc_1(ispin))
1787 CALL dbcsr_release(tempoccocc(ispin))
1788 END DO ! ispin
1789
1790 DEALLOCATE (tempnocc)
1791 DEALLOCATE (tempnocc_1)
1792 DEALLOCATE (tempoccocc)
1793 DEALLOCATE (prec_vv)
1794 DEALLOCATE (siginvtftsiginv)
1795 DEALLOCATE (stsiginv_0)
1796 DEALLOCATE (ftsiginv)
1797 DEALLOCATE (st)
1798 DEALLOCATE (prev_grad)
1799 DEALLOCATE (grad)
1800 DEALLOCATE (prev_step)
1801 DEALLOCATE (step)
1802 DEALLOCATE (prev_minus_prec_grad)
1803 DEALLOCATE (m_sig_sqrti_ii)
1804
1805 DEALLOCATE (domain_r_down)
1806 DEALLOCATE (bad_modes_projector_down)
1807
1808 DEALLOCATE (penalty_occ_vol_g_prefactor)
1809 DEALLOCATE (penalty_occ_vol_h_prefactor)
1810 DEALLOCATE (grad_norm_spin)
1811 DEALLOCATE (nocc)
1812
1813 DEALLOCATE (m_theta, m_t_in_local)
1814 IF (penalty_occ_local) THEN
1815 DO idim0 = 1, dim_op
1816 DO reim = 1, SIZE(op_sm_set_qs, 1)
1817 DEALLOCATE (op_sm_set_qs(reim, idim0)%matrix)
1818 DEALLOCATE (op_sm_set_almo(reim, idim0)%matrix)
1819 END DO
1820 END DO
1821 DEALLOCATE (op_sm_set_qs)
1822 DEALLOCATE (op_sm_set_almo)
1823 DEALLOCATE (weights)
1824 END IF
1825
1826 IF (.NOT. converged .AND. .NOT. optimizer%early_stopping_on) THEN
1827 cpabort("Optimization not converged! ")
1828 END IF
1829
1830 CALL timestop(handle)
1831
1832 END SUBROUTINE almo_scf_xalmo_pcg
1833
1834! **************************************************************************************************
1835!> \brief Optimization of NLMOs using PCG minimizers
1836!> \param qs_env ...
1837!> \param optimizer controls the optimization algorithm
1838!> \param matrix_s - AO overlap (NAOs x NAOs)
1839!> \param matrix_mo_in - initial MOs (NAOs x NMOs)
1840!> \param matrix_mo_out - final MOs (NAOs x NMOs)
1841!> \param template_matrix_sigma - template (NMOs x NMOs)
1842!> \param overlap_determinant - the determinant of the MOs overlap
1843!> \param mat_distr_aos - info on the distribution of AOs
1844!> \param virtuals ...
1845!> \param eps_filter ...
1846!> \par History
1847!> 2018.10 created [Rustam Z Khaliullin]
1848!> \author Rustam Z Khaliullin
1849! **************************************************************************************************
1850 SUBROUTINE almo_scf_construct_nlmos(qs_env, optimizer, &
1851 matrix_s, matrix_mo_in, matrix_mo_out, &
1852 template_matrix_sigma, overlap_determinant, &
1853 mat_distr_aos, virtuals, eps_filter)
1854 TYPE(qs_environment_type), POINTER :: qs_env
1855 TYPE(optimizer_options_type), INTENT(INOUT) :: optimizer
1856 TYPE(dbcsr_type), INTENT(IN) :: matrix_s
1857 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:), &
1858 INTENT(INOUT) :: matrix_mo_in, matrix_mo_out
1859 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:), &
1860 INTENT(IN) :: template_matrix_sigma
1861 REAL(kind=dp), INTENT(INOUT) :: overlap_determinant
1862 INTEGER, INTENT(IN) :: mat_distr_aos
1863 LOGICAL, INTENT(IN) :: virtuals
1864 REAL(kind=dp), INTENT(IN) :: eps_filter
1865
1866 CHARACTER(len=*), PARAMETER :: routinen = 'almo_scf_construct_nlmos'
1867
1868 CHARACTER(LEN=30) :: iter_type, print_string
1869 INTEGER :: cg_iteration, dim_op, handle, iatom, idim0, isgf, ispin, iteration, &
1870 line_search_iteration, linear_search_type, max_iter, natom, ncol, nspins, &
1871 outer_iteration, outer_max_iter, prec_type, reim, unit_nr
1872 INTEGER, ALLOCATABLE, DIMENSION(:) :: first_sgf, last_sgf, nocc, nsgf
1873 LOGICAL :: converged, d_bfgs, just_started, l_bfgs, &
1874 line_search, outer_prepare_to_exit, &
1875 prepare_to_exit, reset_conjugator
1876 REAL(kind=dp) :: appr_sec_der, beta, bfgs_rho, bfgs_sum, denom, denom2, e0, e1, g0, g0sign, &
1877 g1, g1sign, grad_norm, line_search_error, localization_obj_function, &
1878 localization_obj_function_ispin, next_step_size_guess, obj_function_ispin, objf_diff, &
1879 objf_new, objf_old, penalty_amplitude, penalty_func_ispin, penalty_func_new, spin_factor, &
1880 step_size, t1, t2, tempreal
1881 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: diagonal, grad_norm_spin, &
1882 penalty_vol_prefactor, &
1883 suggested_vol_penalty, weights
1884 TYPE(cell_type), POINTER :: cell
1885 TYPE(cp_logger_type), POINTER :: logger
1886 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: qs_matrix_s
1887 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: op_sm_set_almo, op_sm_set_qs
1888 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: approx_inv_hessian, bfgs_s, bfgs_y, grad, &
1889 m_s0, m_sig_sqrti_ii, m_siginv, m_sigma, m_t_mo_local, m_theta, m_theta_normalized, &
1890 prev_grad, prev_m_theta, prev_minus_prec_grad, prev_step, step, tempnocc1, tempoccocc1, &
1891 tempoccocc2, tempoccocc3
1892 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:, :, :) :: m_b0
1893 TYPE(lbfgs_history_type) :: nlmo_lbfgs_history
1894 TYPE(mp_comm_type) :: group
1895 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
1896 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
1897
1898 CALL timeset(routinen, handle)
1899
1900 ! get a useful output_unit
1901 logger => cp_get_default_logger()
1902 IF (logger%para_env%is_source()) THEN
1903 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
1904 ELSE
1905 unit_nr = -1
1906 END IF
1907
1908 nspins = SIZE(matrix_mo_in)
1909
1910 IF (unit_nr > 0) THEN
1911 WRITE (unit_nr, *)
1912 IF (.NOT. virtuals) THEN
1913 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 24), &
1914 " Optimization of occupied NLMOs ", repeat("-", 23)
1915 ELSE
1916 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 24), &
1917 " Optimization of virtual NLMOs ", repeat("-", 24)
1918 END IF
1919 WRITE (unit_nr, *)
1920 WRITE (unit_nr, '(T2,A13,A6,A23,A14,A14,A9)') "Method", "Iter", &
1921 "Objective Function", "Change", "Convergence", "Time"
1922 WRITE (unit_nr, '(T2,A)') repeat("-", 79)
1923 END IF
1924
1925 NULLIFY (particle_set)
1926
1927 CALL get_qs_env(qs_env=qs_env, &
1928 matrix_s=qs_matrix_s, &
1929 cell=cell, &
1930 particle_set=particle_set, &
1931 qs_kind_set=qs_kind_set)
1932
1933 natom = SIZE(particle_set, 1)
1934 ALLOCATE (first_sgf(natom))
1935 ALLOCATE (last_sgf(natom))
1936 ALLOCATE (nsgf(natom))
1937 ! construction of
1938 CALL get_particle_set(particle_set, qs_kind_set, &
1939 first_sgf=first_sgf, last_sgf=last_sgf, nsgf=nsgf)
1940
1941 ! m_theta contains a set of variational parameters
1942 ! that define one-electron orbitals
1943 ALLOCATE (m_theta(nspins))
1944 DO ispin = 1, nspins
1945 CALL dbcsr_create(m_theta(ispin), &
1946 template=template_matrix_sigma(ispin), &
1947 matrix_type=dbcsr_type_no_symmetry)
1948 ! create initial guess for the main variable - identity matrix
1949 CALL dbcsr_set(m_theta(ispin), 0.0_dp)
1950 CALL dbcsr_add_on_diag(m_theta(ispin), 1.0_dp)
1951 END DO
1952
1953 SELECT CASE (optimizer%opt_penalty%operator_type)
1954 CASE (op_loc_berry)
1955
1956 IF (cell%orthorhombic) THEN
1957 dim_op = 3
1958 ELSE
1959 dim_op = 6
1960 END IF
1961 ALLOCATE (weights(6))
1962 weights = 0.0_dp
1963 CALL initialize_weights(cell, weights)
1964 ALLOCATE (op_sm_set_qs(2, dim_op))
1965 ALLOCATE (op_sm_set_almo(2, dim_op))
1966 ! allocate space for T0^t.B.T0
1967 ALLOCATE (m_b0(2, dim_op, nspins))
1968 DO idim0 = 1, dim_op
1969 DO reim = 1, SIZE(op_sm_set_qs, 1)
1970 NULLIFY (op_sm_set_qs(reim, idim0)%matrix, op_sm_set_almo(reim, idim0)%matrix)
1971 ALLOCATE (op_sm_set_qs(reim, idim0)%matrix)
1972 ALLOCATE (op_sm_set_almo(reim, idim0)%matrix)
1973 CALL dbcsr_copy(op_sm_set_qs(reim, idim0)%matrix, qs_matrix_s(1)%matrix, &
1974 name="almo_scf_env%op_sm_"//trim(adjustl(cp_to_string(reim)))//"-"//trim(adjustl(cp_to_string(idim0))))
1975 CALL dbcsr_set(op_sm_set_qs(reim, idim0)%matrix, 0.0_dp)
1976 CALL dbcsr_copy(op_sm_set_almo(reim, idim0)%matrix, matrix_s, &
1977 name="almo_scf_env%op_sm_"//trim(adjustl(cp_to_string(reim)))//"-"//trim(adjustl(cp_to_string(idim0))))
1978 CALL dbcsr_set(op_sm_set_almo(reim, idim0)%matrix, 0.0_dp)
1979 DO ispin = 1, nspins
1980 CALL dbcsr_create(m_b0(reim, idim0, ispin), &
1981 template=m_theta(ispin), &
1982 matrix_type=dbcsr_type_no_symmetry)
1983 CALL dbcsr_set(m_b0(reim, idim0, ispin), 0.0_dp)
1984 END DO
1985 END DO
1986 END DO
1987
1988 CALL compute_berry_operator(qs_env, cell, op_sm_set_qs, dim_op)
1989
1990 CASE (op_loc_pipek)
1991
1992 dim_op = natom
1993 ALLOCATE (weights(dim_op))
1994 weights = 1.0_dp
1995
1996 ALLOCATE (m_b0(1, dim_op, nspins))
1997 !m_B0 first dim is 1 now!
1998 DO idim0 = 1, dim_op
1999 DO reim = 1, 1
2000 DO ispin = 1, nspins
2001 CALL dbcsr_create(m_b0(reim, idim0, ispin), &
2002 template=m_theta(ispin), &
2003 matrix_type=dbcsr_type_no_symmetry)
2004 CALL dbcsr_set(m_b0(reim, idim0, ispin), 0.0_dp)
2005 END DO
2006 END DO
2007 END DO
2008
2009 END SELECT
2010
2011 ! penalty amplitude adjusts the strenght of volume conservation
2012 penalty_amplitude = optimizer%opt_penalty%penalty_strength
2013
2014 ! preconditioner control
2015 prec_type = optimizer%preconditioner
2016
2017 ! use diagonal BFGS if preconditioner is set
2018 d_bfgs = .false.
2019 l_bfgs = .false.
2020 IF (prec_type /= xalmo_prec_zero) l_bfgs = .true.
2021 IF (l_bfgs .AND. (optimizer%conjugator /= cg_zero)) THEN
2022 cpabort("Cannot use conjugators with BFGS")
2023 END IF
2024 IF (l_bfgs) THEN
2025 CALL lbfgs_create(nlmo_lbfgs_history, nspins, nstore=10)
2026 END IF
2027
2028 IF (nspins == 1) THEN
2029 spin_factor = 2.0_dp
2030 ELSE
2031 spin_factor = 1.0_dp
2032 END IF
2033
2034 ALLOCATE (grad_norm_spin(nspins))
2035 ALLOCATE (nocc(nspins))
2036 ALLOCATE (penalty_vol_prefactor(nspins))
2037 ALLOCATE (suggested_vol_penalty(nspins))
2038
2039 ! create a local copy of matrix_mo_in because
2040 ! matrix_mo_in and matrix_mo_out can be the same matrix
2041 ! we need to make sure data in matrix_mo_in is intact
2042 ! after we start writing to matrix_mo_out
2043 ALLOCATE (m_t_mo_local(nspins))
2044 DO ispin = 1, nspins
2045 CALL dbcsr_create(m_t_mo_local(ispin), &
2046 template=matrix_mo_in(ispin), &
2047 matrix_type=dbcsr_type_no_symmetry)
2048 CALL dbcsr_copy(m_t_mo_local(ispin), matrix_mo_in(ispin))
2049 END DO
2050
2051 ALLOCATE (approx_inv_hessian(nspins))
2052 ALLOCATE (m_theta_normalized(nspins))
2053 ALLOCATE (prev_m_theta(nspins))
2054 ALLOCATE (m_s0(nspins))
2055 ALLOCATE (prev_grad(nspins))
2056 ALLOCATE (grad(nspins))
2057 ALLOCATE (prev_step(nspins))
2058 ALLOCATE (step(nspins))
2059 ALLOCATE (prev_minus_prec_grad(nspins))
2060 ALLOCATE (m_sig_sqrti_ii(nspins))
2061 ALLOCATE (m_sigma(nspins))
2062 ALLOCATE (m_siginv(nspins))
2063 ALLOCATE (tempnocc1(nspins))
2064 ALLOCATE (tempoccocc1(nspins))
2065 ALLOCATE (tempoccocc2(nspins))
2066 ALLOCATE (tempoccocc3(nspins))
2067 ALLOCATE (bfgs_y(nspins))
2068 ALLOCATE (bfgs_s(nspins))
2069
2070 DO ispin = 1, nspins
2071
2072 ! init temporary storage
2073 CALL dbcsr_create(tempnocc1(ispin), &
2074 template=matrix_mo_out(ispin), &
2075 matrix_type=dbcsr_type_no_symmetry)
2076 CALL dbcsr_create(approx_inv_hessian(ispin), &
2077 template=m_theta(ispin), &
2078 matrix_type=dbcsr_type_no_symmetry)
2079 CALL dbcsr_create(m_theta_normalized(ispin), &
2080 template=m_theta(ispin), &
2081 matrix_type=dbcsr_type_no_symmetry)
2082 CALL dbcsr_create(prev_m_theta(ispin), &
2083 template=m_theta(ispin), &
2084 matrix_type=dbcsr_type_no_symmetry)
2085 CALL dbcsr_create(m_s0(ispin), &
2086 template=m_theta(ispin), &
2087 matrix_type=dbcsr_type_no_symmetry)
2088 CALL dbcsr_create(prev_grad(ispin), &
2089 template=m_theta(ispin), &
2090 matrix_type=dbcsr_type_no_symmetry)
2091 CALL dbcsr_create(grad(ispin), &
2092 template=m_theta(ispin), &
2093 matrix_type=dbcsr_type_no_symmetry)
2094 CALL dbcsr_create(prev_step(ispin), &
2095 template=m_theta(ispin), &
2096 matrix_type=dbcsr_type_no_symmetry)
2097 CALL dbcsr_create(step(ispin), &
2098 template=m_theta(ispin), &
2099 matrix_type=dbcsr_type_no_symmetry)
2100 CALL dbcsr_create(prev_minus_prec_grad(ispin), &
2101 template=m_theta(ispin), &
2102 matrix_type=dbcsr_type_no_symmetry)
2103 CALL dbcsr_create(m_sig_sqrti_ii(ispin), &
2104 template=m_theta(ispin), &
2105 matrix_type=dbcsr_type_no_symmetry)
2106 CALL dbcsr_create(m_sigma(ispin), &
2107 template=m_theta(ispin), &
2108 matrix_type=dbcsr_type_no_symmetry)
2109 CALL dbcsr_create(m_siginv(ispin), &
2110 template=m_theta(ispin), &
2111 matrix_type=dbcsr_type_no_symmetry)
2112 CALL dbcsr_create(tempoccocc1(ispin), &
2113 template=m_theta(ispin), &
2114 matrix_type=dbcsr_type_no_symmetry)
2115 CALL dbcsr_create(tempoccocc2(ispin), &
2116 template=m_theta(ispin), &
2117 matrix_type=dbcsr_type_no_symmetry)
2118 CALL dbcsr_create(tempoccocc3(ispin), &
2119 template=m_theta(ispin), &
2120 matrix_type=dbcsr_type_no_symmetry)
2121 CALL dbcsr_create(bfgs_s(ispin), &
2122 template=m_theta(ispin), &
2123 matrix_type=dbcsr_type_no_symmetry)
2124 CALL dbcsr_create(bfgs_y(ispin), &
2125 template=m_theta(ispin), &
2126 matrix_type=dbcsr_type_no_symmetry)
2127
2128 CALL dbcsr_set(step(ispin), 0.0_dp)
2129 CALL dbcsr_set(prev_step(ispin), 0.0_dp)
2130
2131 CALL dbcsr_get_info(template_matrix_sigma(ispin), &
2132 nfullrows_total=nocc(ispin))
2133
2134 penalty_vol_prefactor(ispin) = -penalty_amplitude !KEEP: * spin_factor * nocc(ispin)
2135
2136 ! compute m_S0=T0^t.S.T0
2137 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2138 matrix_s, &
2139 m_t_mo_local(ispin), &
2140 0.0_dp, tempnocc1(ispin), &
2141 filter_eps=eps_filter)
2142 CALL dbcsr_multiply("T", "N", 1.0_dp, &
2143 m_t_mo_local(ispin), &
2144 tempnocc1(ispin), &
2145 0.0_dp, m_s0(ispin), &
2146 filter_eps=eps_filter)
2147
2148 SELECT CASE (optimizer%opt_penalty%operator_type)
2149
2150 CASE (op_loc_berry)
2151
2152 ! compute m_B0=T0^t.B.T0
2153 DO idim0 = 1, SIZE(op_sm_set_qs, 2) ! this loop is over miller ind
2154
2155 DO reim = 1, SIZE(op_sm_set_qs, 1) ! this loop is over Re/Im
2156
2157 CALL matrix_qs_to_almo(op_sm_set_qs(reim, idim0)%matrix, &
2158 op_sm_set_almo(reim, idim0)%matrix, mat_distr_aos)
2159
2160 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2161 op_sm_set_almo(reim, idim0)%matrix, &
2162 m_t_mo_local(ispin), &
2163 0.0_dp, tempnocc1(ispin), &
2164 filter_eps=eps_filter)
2165
2166 CALL dbcsr_multiply("T", "N", 1.0_dp, &
2167 m_t_mo_local(ispin), &
2168 tempnocc1(ispin), &
2169 0.0_dp, m_b0(reim, idim0, ispin), &
2170 filter_eps=eps_filter)
2171
2172 DEALLOCATE (op_sm_set_qs(reim, idim0)%matrix)
2173 DEALLOCATE (op_sm_set_almo(reim, idim0)%matrix)
2174
2175 END DO
2176
2177 END DO ! end loop over idim0
2178
2179 CASE (op_loc_pipek)
2180
2181 ! compute m_B0=T0^t.B.T0
2182 DO iatom = 1, natom ! this loop is over "miller" ind
2183
2184 isgf = first_sgf(iatom)
2185 ncol = nsgf(iatom)
2186
2187 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2188 matrix_s, &
2189 m_t_mo_local(ispin), &
2190 0.0_dp, tempnocc1(ispin), &
2191 filter_eps=eps_filter)
2192
2193 CALL dbcsr_multiply("T", "N", 0.5_dp, &
2194 m_t_mo_local(ispin), &
2195 tempnocc1(ispin), &
2196 0.0_dp, m_b0(1, iatom, ispin), &
2197 first_k=isgf, last_k=isgf + ncol - 1, &
2198 filter_eps=eps_filter)
2199
2200 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2201 matrix_s, &
2202 m_t_mo_local(ispin), &
2203 0.0_dp, tempnocc1(ispin), &
2204 first_k=isgf, last_k=isgf + ncol - 1, &
2205 filter_eps=eps_filter)
2206
2207 CALL dbcsr_multiply("T", "N", 0.5_dp, &
2208 m_t_mo_local(ispin), &
2209 tempnocc1(ispin), &
2210 1.0_dp, m_b0(1, iatom, ispin), &
2211 filter_eps=eps_filter)
2212
2213 END DO ! end loop over iatom
2214
2215 END SELECT
2216
2217 END DO ! ispin
2218
2219 IF (optimizer%opt_penalty%operator_type == op_loc_berry) THEN
2220 DO idim0 = 1, SIZE(op_sm_set_qs, 2) ! this loop is over miller ind
2221 DO reim = 1, SIZE(op_sm_set_qs, 1) ! this loop is over Re/Im
2222 DEALLOCATE (op_sm_set_qs(reim, idim0)%matrix)
2223 DEALLOCATE (op_sm_set_almo(reim, idim0)%matrix)
2224 END DO
2225 END DO
2226 DEALLOCATE (op_sm_set_qs, op_sm_set_almo)
2227 END IF
2228
2229 ! start the outer SCF loop
2230 outer_max_iter = optimizer%max_iter_outer_loop
2231 outer_prepare_to_exit = .false.
2232 outer_iteration = 0
2233 grad_norm = 0.0_dp
2234 penalty_func_new = 0.0_dp
2235 linear_search_type = 1 ! safe restart, no quadratic assumption, takes more steps
2236 localization_obj_function = 0.0_dp
2237 penalty_func_new = 0.0_dp
2238
2239 DO
2240
2241 ! start the inner SCF loop
2242 max_iter = optimizer%max_iter
2243 prepare_to_exit = .false.
2244 line_search = .false.
2245 converged = .false.
2246 iteration = 0
2247 cg_iteration = 0
2248 line_search_iteration = 0
2249 obj_function_ispin = 0.0_dp
2250 objf_new = 0.0_dp
2251 objf_old = 0.0_dp
2252 objf_diff = 0.0_dp
2253 line_search_error = 0.0_dp
2254 t1 = m_walltime()
2255 next_step_size_guess = 0.0_dp
2256
2257 DO
2258
2259 just_started = (iteration == 0) .AND. (outer_iteration == 0)
2260
2261 DO ispin = 1, nspins
2262
2263 CALL dbcsr_get_info(m_sig_sqrti_ii(ispin), group=group)
2264
2265 ! compute diagonal (a^t.sigma0.a)^(-1/2)
2266 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2267 m_s0(ispin), m_theta(ispin), 0.0_dp, &
2268 tempoccocc1(ispin), &
2269 filter_eps=eps_filter)
2270 CALL dbcsr_set(m_sig_sqrti_ii(ispin), 0.0_dp)
2271 CALL dbcsr_add_on_diag(m_sig_sqrti_ii(ispin), 1.0_dp)
2272 CALL dbcsr_multiply("T", "N", 1.0_dp, &
2273 m_theta(ispin), tempoccocc1(ispin), 0.0_dp, &
2274 m_sig_sqrti_ii(ispin), &
2275 retain_sparsity=.true.)
2276 ALLOCATE (diagonal(nocc(ispin)))
2277 CALL dbcsr_get_diag(m_sig_sqrti_ii(ispin), diagonal)
2278 CALL group%sum(diagonal)
2279 ! TODO: works for zero diagonal elements?
2280 diagonal(:) = 1.0_dp/sqrt(diagonal(:))
2281 CALL dbcsr_set(m_sig_sqrti_ii(ispin), 0.0_dp)
2282 CALL dbcsr_set_diag(m_sig_sqrti_ii(ispin), diagonal)
2283 DEALLOCATE (diagonal)
2284
2285 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2286 m_theta(ispin), &
2287 m_sig_sqrti_ii(ispin), &
2288 0.0_dp, m_theta_normalized(ispin), &
2289 filter_eps=eps_filter)
2290
2291 ! compute new orbitals
2292 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2293 m_t_mo_local(ispin), &
2294 m_theta_normalized(ispin), &
2295 0.0_dp, matrix_mo_out(ispin), &
2296 filter_eps=eps_filter)
2297
2298 END DO
2299
2300 ! compute objective function
2301 localization_obj_function = 0.0_dp
2302 penalty_func_new = 0.0_dp
2303 DO ispin = 1, nspins
2304
2305 CALL compute_obj_nlmos( &
2306 localization_obj_function_ispin=localization_obj_function_ispin, &
2307 penalty_func_ispin=penalty_func_ispin, &
2308 overlap_determinant=overlap_determinant, &
2309 m_sigma=m_sigma(ispin), &
2310 nocc=nocc(ispin), &
2311 m_b0=m_b0(:, :, ispin), &
2312 m_theta_normalized=m_theta_normalized(ispin), &
2313 template_matrix_mo=matrix_mo_out(ispin), &
2314 weights=weights, &
2315 m_s0=m_s0(ispin), &
2316 just_started=just_started, &
2317 penalty_vol_prefactor=penalty_vol_prefactor(ispin), &
2318 penalty_amplitude=penalty_amplitude, &
2319 eps_filter=eps_filter)
2320
2321 localization_obj_function = localization_obj_function + localization_obj_function_ispin
2322 penalty_func_new = penalty_func_new + penalty_func_ispin
2323
2324 END DO ! ispin
2325 objf_new = penalty_func_new + localization_obj_function
2326
2327 DO ispin = 1, nspins
2328 ! save the previous gradient to compute beta
2329 ! do it only if the previous grad was computed
2330 ! for .NOT.line_search
2331 IF (line_search_iteration == 0 .AND. iteration /= 0) THEN
2332 CALL dbcsr_copy(prev_grad(ispin), grad(ispin))
2333 END IF
2334
2335 END DO ! ispin
2336
2337 ! compute the gradient
2338 DO ispin = 1, nspins
2339
2340 CALL invert_hotelling( &
2341 matrix_inverse=m_siginv(ispin), &
2342 matrix=m_sigma(ispin), &
2343 threshold=eps_filter*10.0_dp, &
2344 filter_eps=eps_filter, &
2345 silent=.false.)
2346
2347 CALL compute_gradient_nlmos( &
2348 m_grad_out=grad(ispin), &
2349 m_b0=m_b0(:, :, ispin), &
2350 weights=weights, &
2351 m_s0=m_s0(ispin), &
2352 m_theta_normalized=m_theta_normalized(ispin), &
2353 m_siginv=m_siginv(ispin), &
2354 m_sig_sqrti_ii=m_sig_sqrti_ii(ispin), &
2355 penalty_vol_prefactor=penalty_vol_prefactor(ispin), &
2356 eps_filter=eps_filter, &
2357 suggested_vol_penalty=suggested_vol_penalty(ispin))
2358
2359 END DO ! ispin
2360
2361 ! check convergence and other exit criteria
2362 DO ispin = 1, nspins
2363 grad_norm_spin(ispin) = dbcsr_maxabs(grad(ispin))
2364 END DO ! ispin
2365 grad_norm = maxval(grad_norm_spin)
2366
2367 converged = (grad_norm <= optimizer%eps_error)
2368 IF (converged .OR. (iteration >= max_iter)) THEN
2369 prepare_to_exit = .true.
2370 END IF
2371
2372 ! it is not time to exit just yet
2373 IF (.NOT. prepare_to_exit) THEN
2374
2375 ! check the gradient along the step direction
2376 ! and decide whether to switch to the line-search mode
2377 ! do not do this in the first iteration
2378 IF (iteration /= 0) THEN
2379
2380 ! enforce at least one line search
2381 ! without even checking the error
2382 IF (.NOT. line_search) THEN
2383
2384 line_search = .true.
2385 line_search_iteration = line_search_iteration + 1
2386
2387 ELSE
2388
2389 ! check the line-search error and decide whether to
2390 ! change the direction
2391 line_search_error = 0.0_dp
2392 denom = 0.0_dp
2393 denom2 = 0.0_dp
2394
2395 DO ispin = 1, nspins
2396
2397 CALL dbcsr_dot(grad(ispin), step(ispin), tempreal)
2398 line_search_error = line_search_error + tempreal
2399 CALL dbcsr_dot(grad(ispin), grad(ispin), tempreal)
2400 denom = denom + tempreal
2401 CALL dbcsr_dot(step(ispin), step(ispin), tempreal)
2402 denom2 = denom2 + tempreal
2403
2404 END DO ! ispin
2405
2406 ! cosine of the angle between the step and grad
2407 ! (must be close to zero at convergence)
2408 line_search_error = line_search_error/sqrt(denom)/sqrt(denom2)
2409
2410 IF (abs(line_search_error) > optimizer%lin_search_eps_error) THEN
2411 line_search = .true.
2412 line_search_iteration = line_search_iteration + 1
2413 ELSE
2414 line_search = .false.
2415 line_search_iteration = 0
2416 END IF
2417
2418 END IF
2419
2420 END IF ! iteration.ne.0
2421
2422 IF (line_search) THEN
2423 objf_diff = 0.0_dp
2424 ELSE
2425 objf_diff = objf_new - objf_old
2426 objf_old = objf_new
2427 END IF
2428
2429 ! update the step direction
2430 IF (.NOT. line_search) THEN
2431
2432 cg_iteration = cg_iteration + 1
2433
2434 ! save the previous step
2435 DO ispin = 1, nspins
2436 CALL dbcsr_copy(prev_step(ispin), step(ispin))
2437 END DO ! ispin
2438
2439 ! compute the new step:
2440 ! if available use second derivative info - bfgs, hessian, preconditioner
2441 IF (prec_type == xalmo_prec_zero) THEN ! no second derivatives
2442
2443 ! no preconditioner
2444 DO ispin = 1, nspins
2445
2446 CALL dbcsr_copy(step(ispin), grad(ispin))
2447 CALL dbcsr_scale(step(ispin), -1.0_dp)
2448
2449 END DO ! ispin
2450
2451 ELSE ! use second derivatives
2452
2453 ! compute and invert hessian/precond?
2454 IF (iteration == 0) THEN
2455
2456 IF (d_bfgs) THEN
2457
2458 ! create matrix filled with 1.0 here
2459 CALL fill_matrix_with_ones(approx_inv_hessian(1))
2460 IF (nspins > 1) THEN
2461 DO ispin = 2, nspins
2462 CALL dbcsr_copy(approx_inv_hessian(ispin), approx_inv_hessian(1))
2463 END DO
2464 END IF
2465
2466 ELSE IF (l_bfgs) THEN
2467
2468 CALL lbfgs_seed(nlmo_lbfgs_history, m_theta, grad)
2469 DO ispin = 1, nspins
2470 CALL dbcsr_copy(step(ispin), grad(ispin))
2471 CALL dbcsr_scale(step(ispin), -1.0_dp)
2472 END DO ! ispin
2473
2474 ELSE
2475
2476 ! computing preconditioner
2477 DO ispin = 1, nspins
2478
2479 ! TODO: write preconditioner code later
2480 ! For now, create matrix filled with 1.0 here
2481 CALL fill_matrix_with_ones(approx_inv_hessian(ispin))
2482 END DO ! ispin
2483
2484 END IF
2485
2486 ELSE ! not iteration zero
2487
2488 ! update approx inverse hessian
2489 IF (d_bfgs) THEN ! diagonal BFGS
2490
2491 DO ispin = 1, nspins
2492
2493 ! compute s and y
2494 CALL dbcsr_copy(bfgs_y(ispin), grad(ispin))
2495 CALL dbcsr_add(bfgs_y(ispin), prev_grad(ispin), 1.0_dp, -1.0_dp)
2496 CALL dbcsr_copy(bfgs_s(ispin), m_theta(ispin))
2497 CALL dbcsr_add(bfgs_s(ispin), prev_m_theta(ispin), 1.0_dp, -1.0_dp)
2498
2499 ! compute rho
2500 CALL dbcsr_dot(grad(ispin), step(ispin), bfgs_rho)
2501 bfgs_rho = 1.0_dp/bfgs_rho
2502
2503 ! compute the sum of the squared elements of bfgs_y
2504 CALL dbcsr_dot(bfgs_y(ispin), bfgs_y(ispin), bfgs_sum)
2505
2506 ! first term: start collecting new inv hessian in this temp matrix
2507 CALL dbcsr_copy(tempoccocc2(ispin), approx_inv_hessian(ispin))
2508
2509 ! second term: + rho * s * s
2510 CALL dbcsr_hadamard_product(bfgs_s(ispin), bfgs_s(ispin), tempoccocc1(ispin))
2511 CALL dbcsr_add(tempoccocc2(ispin), tempoccocc1(ispin), 1.0_dp, bfgs_rho)
2512
2513 ! third term: + rho^2 * s * s * H * sum_(y * y)
2514 CALL dbcsr_hadamard_product(tempoccocc1(ispin), &
2515 approx_inv_hessian(ispin), tempoccocc3(ispin))
2516 CALL dbcsr_add(tempoccocc2(ispin), tempoccocc3(ispin), &
2517 1.0_dp, bfgs_rho*bfgs_rho*bfgs_sum)
2518
2519 ! fourth term: - 2 * rho * s * y * H
2520 CALL dbcsr_hadamard_product(bfgs_y(ispin), &
2521 approx_inv_hessian(ispin), tempoccocc1(ispin))
2522 CALL dbcsr_hadamard_product(bfgs_s(ispin), tempoccocc1(ispin), tempoccocc3(ispin))
2523 CALL dbcsr_add(tempoccocc2(ispin), tempoccocc3(ispin), &
2524 1.0_dp, -2.0_dp*bfgs_rho)
2525
2526 CALL dbcsr_copy(approx_inv_hessian(ispin), tempoccocc2(ispin))
2527
2528 END DO
2529
2530 ELSE IF (l_bfgs) THEN
2531
2532 CALL lbfgs_get_direction(nlmo_lbfgs_history, m_theta, grad, step)
2533
2534 END IF ! which method?
2535
2536 END IF ! compute approximate inverse hessian
2537
2538 IF (.NOT. l_bfgs) THEN
2539
2540 DO ispin = 1, nspins
2541
2542 CALL dbcsr_hadamard_product(approx_inv_hessian(ispin), &
2543 grad(ispin), step(ispin))
2544 CALL dbcsr_scale(step(ispin), -1.0_dp)
2545
2546 END DO ! ispin
2547
2548 END IF
2549
2550 END IF ! second derivative type fork
2551
2552 ! check whether we need to reset conjugate directions
2553 IF (iteration == 0) THEN
2554 reset_conjugator = .true.
2555 END IF
2556
2557 ! compute the conjugation coefficient - beta
2558 IF (.NOT. reset_conjugator) THEN
2559 CALL compute_cg_beta( &
2560 beta=beta, &
2561 reset_conjugator=reset_conjugator, &
2562 conjugator=optimizer%conjugator, &
2563 grad=grad(:), &
2564 prev_grad=prev_grad(:), &
2565 step=step(:), &
2566 prev_step=prev_step(:), &
2567 prev_minus_prec_grad=prev_minus_prec_grad(:) &
2568 )
2569
2570 END IF
2571
2572 IF (reset_conjugator) THEN
2573
2574 beta = 0.0_dp
2575 IF (unit_nr > 0 .AND. (.NOT. just_started)) THEN
2576 WRITE (unit_nr, '(T2,A35)') "Re-setting conjugator to zero"
2577 END IF
2578 reset_conjugator = .false.
2579
2580 END IF
2581
2582 ! save the preconditioned gradient (useful for beta)
2583 DO ispin = 1, nspins
2584
2585 CALL dbcsr_copy(prev_minus_prec_grad(ispin), step(ispin))
2586
2587 ! conjugate the step direction
2588 CALL dbcsr_add(step(ispin), prev_step(ispin), 1.0_dp, beta)
2589
2590 END DO ! ispin
2591
2592 END IF ! update the step direction
2593
2594 ! estimate the step size
2595 IF (.NOT. line_search) THEN
2596 ! we just changed the direction and
2597 ! we have only E and grad from the current step
2598 ! it is not enough to compute step_size - just guess it
2599 e0 = objf_new
2600 g0 = 0.0_dp
2601 DO ispin = 1, nspins
2602 CALL dbcsr_dot(grad(ispin), step(ispin), tempreal)
2603 g0 = g0 + tempreal
2604 END DO ! ispin
2605 g0sign = sign(1.0_dp, g0) ! sign of g0
2606 IF (linear_search_type == 1) THEN ! this is quadratic LS
2607 IF (iteration == 0) THEN
2608 step_size = optimizer%lin_search_step_size_guess
2609 ELSE
2610 IF (next_step_size_guess <= 0.0_dp) THEN
2611 step_size = optimizer%lin_search_step_size_guess
2612 ELSE
2613 ! take the last value
2614 step_size = optimizer%lin_search_step_size_guess
2615 !step_size = next_step_size_guess*1.05_dp
2616 END IF
2617 END IF
2618 ELSE IF (linear_search_type == 2) THEN ! this is cautious LS
2619 ! this LS type is designed not to trust quadratic appr
2620 ! so it always restarts from a safe step size
2621 step_size = optimizer%lin_search_step_size_guess
2622 END IF
2623 IF (unit_nr > 0) THEN
2624 WRITE (unit_nr, '(T21,3A19)') "Line position", "Line grad", "Next line step"
2625 WRITE (unit_nr, '(T2,A19,3F19.5)') "Line search", 0.0_dp, g0, step_size
2626 END IF
2627 next_step_size_guess = step_size
2628 ELSE ! this is not the first line search
2629 e1 = objf_new
2630 g1 = 0.0_dp
2631 DO ispin = 1, nspins
2632 CALL dbcsr_dot(grad(ispin), step(ispin), tempreal)
2633 g1 = g1 + tempreal
2634 END DO ! ispin
2635 g1sign = sign(1.0_dp, g1) ! sign of g1
2636 IF (linear_search_type == 1) THEN
2637 ! we have accumulated some points along this direction
2638 ! use only the most recent g0 (quadratic approximation)
2639 appr_sec_der = (g1 - g0)/step_size
2640 step_size = -g1/appr_sec_der
2641 ELSE IF (linear_search_type == 2) THEN
2642 ! alternative method for finding step size
2643 ! do not use quadratic approximation, only gradient signs
2644 IF (g1sign /= g0sign) THEN
2645 step_size = -step_size/2.0
2646 ELSE
2647 step_size = step_size*1.5
2648 END IF
2649 END IF
2650 ! end alternative LS types
2651 IF (unit_nr > 0) THEN
2652 WRITE (unit_nr, '(T21,3A19)') "Line position", "Line grad", "Next line step"
2653 WRITE (unit_nr, '(T2,A19,3F19.5)') "Line search", next_step_size_guess, g1, step_size
2654 END IF
2655 e0 = e1
2656 g0 = g1
2657 g0sign = g1sign
2658 next_step_size_guess = next_step_size_guess + step_size
2659 END IF
2660
2661 ! update theta
2662 DO ispin = 1, nspins
2663 IF (.NOT. line_search) THEN ! we prepared to perform the first line search
2664 ! "previous" refers to the previous CG step, not the previous LS step
2665 CALL dbcsr_copy(prev_m_theta(ispin), m_theta(ispin))
2666 END IF
2667 CALL dbcsr_add(m_theta(ispin), step(ispin), 1.0_dp, step_size)
2668 END DO ! ispin
2669
2670 END IF ! not.prepare_to_exit
2671
2672 IF (line_search) THEN
2673 iter_type = "LS"
2674 ELSE
2675 iter_type = "CG"
2676 END IF
2677
2678 t2 = m_walltime()
2679 IF (unit_nr > 0) THEN
2680 iter_type = trim("NLMO OPT "//iter_type)
2681 WRITE (unit_nr, '(T2,A13,I6,F23.10,E14.5,F14.9,F9.2)') &
2682 iter_type, iteration, &
2683 objf_new, objf_diff, grad_norm, &
2684 t2 - t1
2685 WRITE (unit_nr, '(T2,A19,F23.10)') &
2686 "Localization:", localization_obj_function
2687 WRITE (unit_nr, '(T2,A19,F23.10)') &
2688 "Orthogonalization:", penalty_func_new
2689 END IF
2690 t1 = m_walltime()
2691
2692 iteration = iteration + 1
2693 IF (prepare_to_exit) EXIT
2694
2695 END DO ! inner loop
2696
2697 IF (converged .OR. (outer_iteration >= outer_max_iter)) THEN
2698 outer_prepare_to_exit = .true.
2699 END IF
2700
2701 outer_iteration = outer_iteration + 1
2702 IF (outer_prepare_to_exit) EXIT
2703
2704 END DO ! outer loop
2705
2706 ! return the optimal determinant penalty
2707 optimizer%opt_penalty%penalty_strength = 0.0_dp
2708 DO ispin = 1, nspins
2709 optimizer%opt_penalty%penalty_strength = optimizer%opt_penalty%penalty_strength + &
2710 (-1.0_dp)*penalty_vol_prefactor(ispin)
2711 END DO
2712 optimizer%opt_penalty%penalty_strength = optimizer%opt_penalty%penalty_strength/nspins
2713
2714 IF (converged) THEN
2715 iter_type = "Final"
2716 ELSE
2717 iter_type = "Unconverged"
2718 END IF
2719
2720 IF (unit_nr > 0) THEN
2721 WRITE (unit_nr, '()')
2722 print_string = trim(iter_type)//" localization:"
2723 WRITE (unit_nr, '(T2,A29,F30.10)') &
2724 print_string, localization_obj_function
2725 print_string = trim(iter_type)//" determinant:"
2726 WRITE (unit_nr, '(T2,A29,F30.10)') &
2727 print_string, overlap_determinant
2728 print_string = trim(iter_type)//" penalty strength:"
2729 WRITE (unit_nr, '(T2,A29,F30.10)') &
2730 print_string, optimizer%opt_penalty%penalty_strength
2731 END IF
2732
2733 ! clean up
2734 IF (l_bfgs) THEN
2735 CALL lbfgs_release(nlmo_lbfgs_history)
2736 END IF
2737 DO ispin = 1, nspins
2738 DO idim0 = 1, SIZE(m_b0, 2)
2739 DO reim = 1, SIZE(m_b0, 1)
2740 CALL dbcsr_release(m_b0(reim, idim0, ispin))
2741 END DO
2742 END DO
2743 CALL dbcsr_release(m_theta(ispin))
2744 CALL dbcsr_release(m_t_mo_local(ispin))
2745 CALL dbcsr_release(tempnocc1(ispin))
2746 CALL dbcsr_release(approx_inv_hessian(ispin))
2747 CALL dbcsr_release(prev_m_theta(ispin))
2748 CALL dbcsr_release(m_theta_normalized(ispin))
2749 CALL dbcsr_release(m_s0(ispin))
2750 CALL dbcsr_release(prev_grad(ispin))
2751 CALL dbcsr_release(grad(ispin))
2752 CALL dbcsr_release(prev_step(ispin))
2753 CALL dbcsr_release(step(ispin))
2754 CALL dbcsr_release(prev_minus_prec_grad(ispin))
2755 CALL dbcsr_release(m_sig_sqrti_ii(ispin))
2756 CALL dbcsr_release(m_sigma(ispin))
2757 CALL dbcsr_release(m_siginv(ispin))
2758 CALL dbcsr_release(tempoccocc1(ispin))
2759 CALL dbcsr_release(tempoccocc2(ispin))
2760 CALL dbcsr_release(tempoccocc3(ispin))
2761 CALL dbcsr_release(bfgs_y(ispin))
2762 CALL dbcsr_release(bfgs_s(ispin))
2763 END DO ! ispin
2764
2765 DEALLOCATE (grad_norm_spin)
2766 DEALLOCATE (nocc)
2767 DEALLOCATE (penalty_vol_prefactor)
2768 DEALLOCATE (suggested_vol_penalty)
2769
2770 DEALLOCATE (approx_inv_hessian)
2771 DEALLOCATE (prev_m_theta)
2772 DEALLOCATE (m_theta_normalized)
2773 DEALLOCATE (m_s0)
2774 DEALLOCATE (prev_grad)
2775 DEALLOCATE (grad)
2776 DEALLOCATE (prev_step)
2777 DEALLOCATE (step)
2778 DEALLOCATE (prev_minus_prec_grad)
2779 DEALLOCATE (m_sig_sqrti_ii)
2780 DEALLOCATE (m_sigma)
2781 DEALLOCATE (m_siginv)
2782 DEALLOCATE (tempnocc1)
2783 DEALLOCATE (tempoccocc1)
2784 DEALLOCATE (tempoccocc2)
2785 DEALLOCATE (tempoccocc3)
2786 DEALLOCATE (bfgs_y)
2787 DEALLOCATE (bfgs_s)
2788
2789 DEALLOCATE (m_theta, m_t_mo_local)
2790 DEALLOCATE (m_b0)
2791 DEALLOCATE (weights)
2792 DEALLOCATE (first_sgf, last_sgf, nsgf)
2793
2794 IF (.NOT. converged) THEN
2795 cpabort("Optimization not converged! ")
2796 END IF
2797
2798 CALL timestop(handle)
2799
2800 END SUBROUTINE almo_scf_construct_nlmos
2801
2802! **************************************************************************************************
2803!> \brief Analysis of the orbitals
2804!> \param detailed_analysis ...
2805!> \param eps_filter ...
2806!> \param m_T_in ...
2807!> \param m_T0_in ...
2808!> \param m_siginv_in ...
2809!> \param m_siginv0_in ...
2810!> \param m_S_in ...
2811!> \param m_KS0_in ...
2812!> \param m_quench_t_in ...
2813!> \param energy_out ...
2814!> \param m_eda_out ...
2815!> \param m_cta_out ...
2816!> \par History
2817!> 2017.07 created [Rustam Z Khaliullin]
2818!> \author Rustam Z Khaliullin
2819! **************************************************************************************************
2820 SUBROUTINE xalmo_analysis(detailed_analysis, eps_filter, m_T_in, m_T0_in, &
2821 m_siginv_in, m_siginv0_in, m_S_in, m_KS0_in, m_quench_t_in, energy_out, &
2822 m_eda_out, m_cta_out)
2823
2824 LOGICAL, INTENT(IN) :: detailed_analysis
2825 REAL(kind=dp), INTENT(IN) :: eps_filter
2826 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_t_in, m_t0_in, m_siginv_in, &
2827 m_siginv0_in, m_s_in, m_ks0_in, &
2828 m_quench_t_in
2829 REAL(kind=dp), INTENT(INOUT) :: energy_out
2830 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_eda_out, m_cta_out
2831
2832 CHARACTER(len=*), PARAMETER :: routinen = 'xalmo_analysis'
2833
2834 INTEGER :: handle, ispin, nspins
2835 REAL(kind=dp) :: energy_ispin, spin_factor
2836 TYPE(dbcsr_type) :: ftsiginv0, fvo0, m_x, siginvtftsiginv0, &
2837 st0
2838
2839 CALL timeset(routinen, handle)
2840
2841 nspins = SIZE(m_t_in)
2842
2843 IF (nspins == 1) THEN
2844 spin_factor = 2.0_dp
2845 ELSE
2846 spin_factor = 1.0_dp
2847 END IF
2848
2849 energy_out = 0.0_dp
2850 DO ispin = 1, nspins
2851
2852 ! create temporary matrices
2853 CALL dbcsr_create(fvo0, &
2854 template=m_t_in(ispin), &
2855 matrix_type=dbcsr_type_no_symmetry)
2856 CALL dbcsr_create(ftsiginv0, &
2857 template=m_t_in(ispin), &
2858 matrix_type=dbcsr_type_no_symmetry)
2859 CALL dbcsr_create(st0, &
2860 template=m_t_in(ispin), &
2861 matrix_type=dbcsr_type_no_symmetry)
2862 CALL dbcsr_create(m_x, &
2863 template=m_t_in(ispin), &
2864 matrix_type=dbcsr_type_no_symmetry)
2865 CALL dbcsr_create(siginvtftsiginv0, &
2866 template=m_siginv0_in(ispin), &
2867 matrix_type=dbcsr_type_no_symmetry)
2868
2869 ! compute F_{virt,occ} for the zero-delocalization state
2870 CALL compute_frequently_used_matrices( &
2871 filter_eps=eps_filter, &
2872 m_t_in=m_t0_in(ispin), &
2873 m_siginv_in=m_siginv0_in(ispin), &
2874 m_s_in=m_s_in(1), &
2875 m_f_in=m_ks0_in(ispin), &
2876 m_ftsiginv_out=ftsiginv0, &
2877 m_siginvtftsiginv_out=siginvtftsiginv0, &
2878 m_st_out=st0)
2879 CALL dbcsr_copy(fvo0, m_quench_t_in(ispin))
2880 CALL dbcsr_copy(fvo0, ftsiginv0, keep_sparsity=.true.)
2881 CALL dbcsr_multiply("N", "N", -1.0_dp, &
2882 st0, &
2883 siginvtftsiginv0, &
2884 1.0_dp, fvo0, &
2885 retain_sparsity=.true.)
2886
2887 ! get single excitation amplitudes
2888 CALL dbcsr_copy(m_x, m_t0_in(ispin))
2889 CALL dbcsr_add(m_x, m_t_in(ispin), -1.0_dp, 1.0_dp)
2890
2891 CALL dbcsr_dot(m_x, fvo0, energy_ispin)
2892 energy_out = energy_out + energy_ispin*spin_factor
2893
2894 IF (detailed_analysis) THEN
2895
2896 CALL dbcsr_hadamard_product(m_x, fvo0, m_eda_out(ispin))
2897 CALL dbcsr_scale(m_eda_out(ispin), spin_factor)
2898 CALL dbcsr_filter(m_eda_out(ispin), eps_filter)
2899
2900 ! first, compute [QR'R]_mu^i = [(S-SRS).X.siginv']_mu^i
2901 ! a. FTsiginv0 = S.T0*siginv0
2902 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2903 st0, &
2904 m_siginv0_in(ispin), &
2905 0.0_dp, ftsiginv0, &
2906 filter_eps=eps_filter)
2907 ! c. tmp1(use ST0) = S.X
2908 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2909 m_s_in(1), &
2910 m_x, &
2911 0.0_dp, st0, &
2912 filter_eps=eps_filter)
2913 ! d. tmp2 = tr(T0).tmp1 = tr(T0).S.X
2914 CALL dbcsr_multiply("T", "N", 1.0_dp, &
2915 m_t0_in(ispin), &
2916 st0, &
2917 0.0_dp, siginvtftsiginv0, &
2918 filter_eps=eps_filter)
2919 ! e. tmp1 = tmp1 - tmp3.tmp2 = S.X - S.T0.siginv0*tr(T0).S.X
2920 ! = (1-S.R0).S.X
2921 CALL dbcsr_multiply("N", "N", -1.0_dp, &
2922 ftsiginv0, &
2923 siginvtftsiginv0, &
2924 1.0_dp, st0, &
2925 filter_eps=eps_filter)
2926 ! f. tmp2(use FTsiginv0) = tmp1*siginv
2927 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2928 st0, &
2929 m_siginv_in(ispin), &
2930 0.0_dp, ftsiginv0, &
2931 filter_eps=eps_filter)
2932 ! second, compute traces of blocks [RR'Q]^x_y * [X]^y_x
2933 CALL dbcsr_hadamard_product(m_x, &
2934 ftsiginv0, m_cta_out(ispin))
2935 CALL dbcsr_scale(m_cta_out(ispin), spin_factor)
2936 CALL dbcsr_filter(m_cta_out(ispin), eps_filter)
2937
2938 END IF ! do ALMO EDA/CTA
2939
2940 CALL dbcsr_release(fvo0)
2941 CALL dbcsr_release(ftsiginv0)
2942 CALL dbcsr_release(st0)
2943 CALL dbcsr_release(m_x)
2944 CALL dbcsr_release(siginvtftsiginv0)
2945
2946 END DO ! ispin
2947
2948 CALL timestop(handle)
2949
2950 END SUBROUTINE xalmo_analysis
2951
2952! **************************************************************************************************
2953!> \brief Compute matrices that are used often in various parts of the
2954!> optimization procedure
2955!> \param filter_eps ...
2956!> \param m_T_in ...
2957!> \param m_siginv_in ...
2958!> \param m_S_in ...
2959!> \param m_F_in ...
2960!> \param m_FTsiginv_out ...
2961!> \param m_siginvTFTsiginv_out ...
2962!> \param m_ST_out ...
2963!> \par History
2964!> 2016.12 created [Rustam Z Khaliullin]
2965!> \author Rustam Z Khaliullin
2966! **************************************************************************************************
2967 SUBROUTINE compute_frequently_used_matrices(filter_eps, &
2968 m_T_in, m_siginv_in, m_S_in, m_F_in, m_FTsiginv_out, &
2969 m_siginvTFTsiginv_out, m_ST_out)
2970
2971 REAL(kind=dp), INTENT(IN) :: filter_eps
2972 TYPE(dbcsr_type), INTENT(IN) :: m_t_in, m_siginv_in, m_s_in, m_f_in
2973 TYPE(dbcsr_type), INTENT(INOUT) :: m_ftsiginv_out, m_siginvtftsiginv_out, &
2974 m_st_out
2975
2976 CHARACTER(len=*), PARAMETER :: routinen = 'compute_frequently_used_matrices'
2977
2978 INTEGER :: handle
2979 TYPE(dbcsr_type) :: m_tmp_no_1, m_tmp_oo_1
2980
2981 CALL timeset(routinen, handle)
2982
2983 CALL dbcsr_create(m_tmp_no_1, &
2984 template=m_t_in, &
2985 matrix_type=dbcsr_type_no_symmetry)
2986 CALL dbcsr_create(m_tmp_oo_1, &
2987 template=m_siginv_in, &
2988 matrix_type=dbcsr_type_no_symmetry)
2989
2990 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2991 m_f_in, &
2992 m_t_in, &
2993 0.0_dp, m_tmp_no_1, &
2994 filter_eps=filter_eps)
2995
2996 CALL dbcsr_multiply("N", "N", 1.0_dp, &
2997 m_tmp_no_1, &
2998 m_siginv_in, &
2999 0.0_dp, m_ftsiginv_out, &
3000 filter_eps=filter_eps)
3001
3002 CALL dbcsr_multiply("T", "N", 1.0_dp, &
3003 m_t_in, &
3004 m_ftsiginv_out, &
3005 0.0_dp, m_tmp_oo_1, &
3006 filter_eps=filter_eps)
3007
3008 CALL dbcsr_multiply("N", "N", 1.0_dp, &
3009 m_siginv_in, &
3010 m_tmp_oo_1, &
3011 0.0_dp, m_siginvtftsiginv_out, &
3012 filter_eps=filter_eps)
3013
3014 CALL dbcsr_multiply("N", "N", 1.0_dp, &
3015 m_s_in, &
3016 m_t_in, &
3017 0.0_dp, m_st_out, &
3018 filter_eps=filter_eps)
3019
3020 CALL dbcsr_release(m_tmp_no_1)
3021 CALL dbcsr_release(m_tmp_oo_1)
3022
3023 CALL timestop(handle)
3024
3025 END SUBROUTINE compute_frequently_used_matrices
3026
3027! **************************************************************************************************
3028!> \brief Split the matrix of virtual orbitals into two:
3029!> retained orbs and discarded
3030!> \param almo_scf_env ...
3031!> \par History
3032!> 2011.09 created [Rustam Z Khaliullin]
3033!> \author Rustam Z Khaliullin
3034! **************************************************************************************************
3035 SUBROUTINE split_v_blk(almo_scf_env)
3036
3037 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
3038
3039 CHARACTER(len=*), PARAMETER :: routinen = 'split_v_blk'
3040
3041 INTEGER :: discarded_v, handle, iblock_col, &
3042 iblock_col_size, iblock_row, &
3043 iblock_row_size, ispin, retained_v
3044 REAL(kind=dp), DIMENSION(:, :), POINTER :: data_p
3045 TYPE(dbcsr_iterator_type) :: iter
3046
3047 CALL timeset(routinen, handle)
3048
3049 DO ispin = 1, almo_scf_env%nspins
3050
3051 CALL dbcsr_work_create(almo_scf_env%matrix_v_blk(ispin), &
3052 work_mutable=.true.)
3053 CALL dbcsr_work_create(almo_scf_env%matrix_v_disc_blk(ispin), &
3054 work_mutable=.true.)
3055
3056 CALL dbcsr_iterator_start(iter, almo_scf_env%matrix_v_full_blk(ispin))
3057
3058 DO WHILE (dbcsr_iterator_blocks_left(iter))
3059
3060 CALL dbcsr_iterator_next_block(iter, iblock_row, iblock_col, data_p, &
3061 row_size=iblock_row_size, col_size=iblock_col_size)
3062
3063 IF (iblock_row /= iblock_col) THEN
3064 cpabort("off-diagonal block found")
3065 END IF
3066
3067 retained_v = almo_scf_env%nvirt_of_domain(iblock_col, ispin)
3068 discarded_v = almo_scf_env%nvirt_disc_of_domain(iblock_col, ispin)
3069 cpassert(retained_v > 0)
3070 cpassert(discarded_v > 0)
3071 CALL dbcsr_put_block(almo_scf_env%matrix_v_disc_blk(ispin), iblock_row, iblock_col, &
3072 block=data_p(:, (retained_v + 1):iblock_col_size))
3073 CALL dbcsr_put_block(almo_scf_env%matrix_v_blk(ispin), iblock_row, iblock_col, &
3074 block=data_p(:, 1:retained_v))
3075
3076 END DO ! iterator
3077 CALL dbcsr_iterator_stop(iter)
3078
3079 CALL dbcsr_finalize(almo_scf_env%matrix_v_blk(ispin))
3080 CALL dbcsr_finalize(almo_scf_env%matrix_v_disc_blk(ispin))
3081
3082 END DO ! ispin
3083
3084 CALL timestop(handle)
3085
3086 END SUBROUTINE split_v_blk
3087
3088! **************************************************************************************************
3089!> \brief various methods for calculating the Harris-Foulkes correction
3090!> \param almo_scf_env ...
3091!> \par History
3092!> 2011.06 created [Rustam Z Khaliullin]
3093!> \author Rustam Z Khaliullin
3094! **************************************************************************************************
3095 SUBROUTINE harris_foulkes_correction(almo_scf_env)
3096
3097 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
3098
3099 CHARACTER(len=*), PARAMETER :: routinen = 'harris_foulkes_correction'
3100 INTEGER, PARAMETER :: cayley_transform = 1, dm_ls_step = 2
3101
3102 INTEGER :: algorithm_id, handle, handle1, handle2, handle3, handle4, handle5, handle6, &
3103 handle7, handle8, ispin, iteration, n, nmins, nspin, opt_k_max_iter, &
3104 outer_opt_k_iteration, outer_opt_k_max_iter, unit_nr
3105 INTEGER, DIMENSION(1) :: fake, nelectron_spin_real
3106 LOGICAL :: converged, line_search, md_in_k_space, outer_opt_k_prepare_to_exit, &
3107 prepare_to_exit, reset_conjugator, reset_step_size, use_cubic_approximation, &
3108 use_quadratic_approximation
3109 REAL(kind=dp) :: aa, bb, beta, conjugacy_error, conjugacy_error_threshold, &
3110 delta_obj_function, denom, energy_correction_final, frob_matrix, frob_matrix_base, fun0, &
3111 fun1, gfun0, gfun1, grad_norm, grad_norm_frob, kappa, kin_energy, line_search_error, &
3112 line_search_error_threshold, num_threshold, numer, obj_function, quadratic_approx_error, &
3113 quadratic_approx_error_threshold, safety_multiplier, spin_factor, step_size, &
3114 step_size_quadratic_approx, step_size_quadratic_approx2, t1, t1a, t1cholesky, t2, t2a, &
3115 t2cholesky, tau, time_step, x_opt_eps_adaptive, x_opt_eps_adaptive_factor
3116 REAL(kind=dp), DIMENSION(1) :: local_mu
3117 REAL(kind=dp), DIMENSION(2) :: energy_correction
3118 REAL(kind=dp), DIMENSION(3) :: minima
3119 TYPE(cp_logger_type), POINTER :: logger
3120 TYPE(ct_step_env_type) :: ct_step_env
3121 TYPE(dbcsr_type) :: grad, k_vd_index_down, k_vr_index_down, matrix_k_central, matrix_tmp1, &
3122 matrix_tmp2, prec, prev_grad, prev_minus_prec_grad, prev_step, sigma_oo_curr, &
3123 sigma_oo_curr_inv, sigma_vv_sqrt, sigma_vv_sqrt_guess, sigma_vv_sqrt_inv, &
3124 sigma_vv_sqrt_inv_guess, step, t_curr, tmp1_n_vr, tmp2_n_o, tmp3_vd_vr, tmp4_o_vr, &
3125 tmp_k_blk, vd_fixed, vd_index_sqrt, vd_index_sqrt_inv, velocity, vr_fixed, vr_index_sqrt, &
3126 vr_index_sqrt_inv
3127 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: matrix_p_almo_scf_converged
3128
3129 CALL timeset(routinen, handle)
3130
3131 ! get a useful output_unit
3132 logger => cp_get_default_logger()
3133 IF (logger%para_env%is_source()) THEN
3134 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
3135 ELSE
3136 unit_nr = -1
3137 END IF
3138
3139 nspin = almo_scf_env%nspins
3140 energy_correction_final = 0.0_dp
3141 IF (nspin == 1) THEN
3142 spin_factor = 2.0_dp
3143 ELSE
3144 spin_factor = 1.0_dp
3145 END IF
3146
3147 IF (almo_scf_env%deloc_use_occ_orbs) THEN
3148 algorithm_id = cayley_transform
3149 ELSE
3150 algorithm_id = dm_ls_step
3151 END IF
3152
3153 t1 = m_walltime()
3154
3155 SELECT CASE (algorithm_id)
3156 CASE (cayley_transform)
3157
3158 ! rescale density matrix by spin factor
3159 ! so the orbitals and density are consistent with each other
3160 IF (almo_scf_env%nspins == 1) THEN
3161 CALL dbcsr_scale(almo_scf_env%matrix_p(1), 1.0_dp/spin_factor)
3162 END IF
3163
3164 ! transform matrix_t not matrix_t_blk (we might need ALMOs later)
3165 DO ispin = 1, nspin
3166
3167 CALL dbcsr_copy(almo_scf_env%matrix_t(ispin), &
3168 almo_scf_env%matrix_t_blk(ispin))
3169
3170 ! obtain orthogonalization matrices for ALMOs
3171 ! RZK-warning - remove this sqrt(sigma) and inv(sqrt(sigma))
3172 ! ideally ALMO scf should use sigma and sigma_inv in
3173 ! the tensor_up_down representation
3174
3175 IF (unit_nr > 0) THEN
3176 WRITE (unit_nr, *) "sqrt and inv(sqrt) of MO overlap matrix"
3177 END IF
3178 CALL dbcsr_create(almo_scf_env%matrix_sigma_sqrt(ispin), &
3179 template=almo_scf_env%matrix_sigma(ispin), &
3180 matrix_type=dbcsr_type_no_symmetry)
3181 CALL dbcsr_create(almo_scf_env%matrix_sigma_sqrt_inv(ispin), &
3182 template=almo_scf_env%matrix_sigma(ispin), &
3183 matrix_type=dbcsr_type_no_symmetry)
3184
3185 CALL matrix_sqrt_newton_schulz(almo_scf_env%matrix_sigma_sqrt(ispin), &
3186 almo_scf_env%matrix_sigma_sqrt_inv(ispin), &
3187 almo_scf_env%matrix_sigma(ispin), &
3188 threshold=almo_scf_env%eps_filter, &
3189 order=almo_scf_env%order_lanczos, &
3190 eps_lanczos=almo_scf_env%eps_lanczos, &
3191 max_iter_lanczos=almo_scf_env%max_iter_lanczos)
3192
3193 IF (safe_mode) THEN
3194 CALL dbcsr_create(matrix_tmp1, template=almo_scf_env%matrix_sigma(ispin), &
3195 matrix_type=dbcsr_type_no_symmetry)
3196 CALL dbcsr_create(matrix_tmp2, template=almo_scf_env%matrix_sigma(ispin), &
3197 matrix_type=dbcsr_type_no_symmetry)
3198
3199 CALL dbcsr_multiply("N", "N", 1.0_dp, almo_scf_env%matrix_sigma_sqrt_inv(ispin), &
3200 almo_scf_env%matrix_sigma(ispin), &
3201 0.0_dp, matrix_tmp1, filter_eps=almo_scf_env%eps_filter)
3202 CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_tmp1, &
3203 almo_scf_env%matrix_sigma_sqrt_inv(ispin), &
3204 0.0_dp, matrix_tmp2, filter_eps=almo_scf_env%eps_filter)
3205
3206 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp2)
3207 CALL dbcsr_add_on_diag(matrix_tmp2, -1.0_dp)
3208 frob_matrix = dbcsr_frobenius_norm(matrix_tmp2)
3209 IF (unit_nr > 0) THEN
3210 WRITE (unit_nr, *) "Error for (inv(sqrt(SIG))*SIG*inv(sqrt(SIG))-I)", frob_matrix/frob_matrix_base
3211 END IF
3212
3213 CALL dbcsr_release(matrix_tmp1)
3214 CALL dbcsr_release(matrix_tmp2)
3215 END IF
3216 END DO
3217
3218 IF (almo_scf_env%almo_update_algorithm == almo_scf_diag) THEN
3219
3220 DO ispin = 1, nspin
3221
3222 t1a = m_walltime()
3223
3224 line_search_error_threshold = almo_scf_env%real01
3225 conjugacy_error_threshold = almo_scf_env%real02
3226 quadratic_approx_error_threshold = almo_scf_env%real03
3227 x_opt_eps_adaptive_factor = almo_scf_env%real04
3228
3229 !! the outer loop for k optimization
3230 outer_opt_k_max_iter = almo_scf_env%opt_k_outer_max_iter
3231 outer_opt_k_prepare_to_exit = .false.
3232 outer_opt_k_iteration = 0
3233 grad_norm = 0.0_dp
3234 grad_norm_frob = 0.0_dp
3235 CALL dbcsr_set(almo_scf_env%matrix_x(ispin), 0.0_dp)
3236 IF (almo_scf_env%deloc_truncate_virt == virt_full) outer_opt_k_max_iter = 0
3237
3238 DO
3239
3240 ! obtain proper retained virtuals (1-R)|ALMO_vr>
3241 CALL apply_projector(psi_in=almo_scf_env%matrix_v_blk(ispin), &
3242 psi_out=almo_scf_env%matrix_v(ispin), &
3243 psi_projector=almo_scf_env%matrix_t_blk(ispin), &
3244 metric=almo_scf_env%matrix_s(1), &
3245 project_out=.true., &
3246 psi_projector_orthogonal=.false., &
3247 proj_in_template=almo_scf_env%matrix_ov(ispin), &
3248 eps_filter=almo_scf_env%eps_filter, &
3249 sig_inv_projector=almo_scf_env%matrix_sigma_inv(ispin))
3250
3251 ! save initial retained virtuals
3252 CALL dbcsr_create(vr_fixed, &
3253 template=almo_scf_env%matrix_v(ispin))
3254 CALL dbcsr_copy(vr_fixed, almo_scf_env%matrix_v(ispin))
3255
3256 ! init matrices common for optimized and non-optimized virts
3257 CALL dbcsr_create(sigma_vv_sqrt, &
3258 template=almo_scf_env%matrix_sigma_vv(ispin), &
3259 matrix_type=dbcsr_type_no_symmetry)
3260 CALL dbcsr_create(sigma_vv_sqrt_inv, &
3261 template=almo_scf_env%matrix_sigma_vv(ispin), &
3262 matrix_type=dbcsr_type_no_symmetry)
3263 CALL dbcsr_create(sigma_vv_sqrt_inv_guess, &
3264 template=almo_scf_env%matrix_sigma_vv(ispin), &
3265 matrix_type=dbcsr_type_no_symmetry)
3266 CALL dbcsr_create(sigma_vv_sqrt_guess, &
3267 template=almo_scf_env%matrix_sigma_vv(ispin), &
3268 matrix_type=dbcsr_type_no_symmetry)
3269 CALL dbcsr_set(sigma_vv_sqrt_guess, 0.0_dp)
3270 CALL dbcsr_add_on_diag(sigma_vv_sqrt_guess, 1.0_dp)
3271 CALL dbcsr_filter(sigma_vv_sqrt_guess, almo_scf_env%eps_filter)
3272 CALL dbcsr_set(sigma_vv_sqrt_inv_guess, 0.0_dp)
3273 CALL dbcsr_add_on_diag(sigma_vv_sqrt_inv_guess, 1.0_dp)
3274 CALL dbcsr_filter(sigma_vv_sqrt_inv_guess, almo_scf_env%eps_filter)
3275
3276 ! do things required to optimize virtuals
3277 IF (almo_scf_env%deloc_truncate_virt /= virt_full) THEN
3278
3279 ! project retained virtuals out of discarded block-by-block
3280 ! (1-Q^VR_ALMO)|ALMO_vd>
3281 ! this is probably not necessary, do it just to be safe
3282
3283 ! construct discarded virtuals (1-R)|ALMO_vd>
3284 CALL apply_projector(psi_in=almo_scf_env%matrix_v_disc_blk(ispin), &
3285 psi_out=almo_scf_env%matrix_v_disc(ispin), &
3286 psi_projector=almo_scf_env%matrix_t_blk(ispin), &
3287 metric=almo_scf_env%matrix_s(1), &
3288 project_out=.true., &
3289 psi_projector_orthogonal=.false., &
3290 proj_in_template=almo_scf_env%matrix_ov_disc(ispin), &
3291 eps_filter=almo_scf_env%eps_filter, &
3292 sig_inv_projector=almo_scf_env%matrix_sigma_inv(ispin))
3293 !sig_inv_template=almo_scf_env%matrix_sigma_inv(ispin),&
3294
3295 ! save initial discarded
3296 CALL dbcsr_create(vd_fixed, &
3297 template=almo_scf_env%matrix_v_disc(ispin))
3298 CALL dbcsr_copy(vd_fixed, almo_scf_env%matrix_v_disc(ispin))
3299
3300 !! create the down metric in the retained k-subspace
3301 CALL dbcsr_create(k_vr_index_down, &
3302 template=almo_scf_env%matrix_sigma_vv_blk(ispin), &
3303 matrix_type=dbcsr_type_no_symmetry)
3304
3305 !! create the up metric in the discarded k-subspace
3306 CALL dbcsr_create(k_vd_index_down, &
3307 template=almo_scf_env%matrix_vv_disc_blk(ispin), &
3308 matrix_type=dbcsr_type_no_symmetry)
3309
3310 ! init matrices necessary for optimization of truncated virts
3311 ! init blocked gradient before setting K to zero
3312 ! otherwise the block structure might be lost
3313 CALL dbcsr_create(grad, &
3314 template=almo_scf_env%matrix_k_blk(ispin))
3315 CALL dbcsr_copy(grad, almo_scf_env%matrix_k_blk(ispin))
3316
3317 ! init MD in the k-space
3318 md_in_k_space = almo_scf_env%logical01
3319 IF (md_in_k_space) THEN
3320 CALL dbcsr_create(velocity, &
3321 template=almo_scf_env%matrix_k_blk(ispin))
3322 CALL dbcsr_copy(velocity, almo_scf_env%matrix_k_blk(ispin))
3323 CALL dbcsr_set(velocity, 0.0_dp)
3324 time_step = almo_scf_env%opt_k_trial_step_size
3325 END IF
3326
3327 CALL dbcsr_create(prev_step, &
3328 template=almo_scf_env%matrix_k_blk(ispin))
3329
3330 CALL dbcsr_create(prev_minus_prec_grad, &
3331 template=almo_scf_env%matrix_k_blk(ispin))
3332
3333 ! initialize diagonal blocks of the preconditioner to 1.0_dp
3334 CALL dbcsr_create(prec, &
3335 template=almo_scf_env%matrix_k_blk(ispin))
3336 CALL dbcsr_copy(prec, almo_scf_env%matrix_k_blk(ispin))
3337 CALL dbcsr_set(prec, 1.0_dp)
3338
3339 ! generate initial K (extrapolate if previous values are available)
3340 CALL dbcsr_set(almo_scf_env%matrix_k_blk(ispin), 0.0_dp)
3341 ! matrix_k_central stores current k because matrix_k_blk is updated
3342 ! during linear search
3343 CALL dbcsr_create(matrix_k_central, &
3344 template=almo_scf_env%matrix_k_blk(ispin))
3345 CALL dbcsr_copy(matrix_k_central, &
3346 almo_scf_env%matrix_k_blk(ispin))
3347 CALL dbcsr_create(tmp_k_blk, &
3348 template=almo_scf_env%matrix_k_blk(ispin))
3349 CALL dbcsr_create(step, &
3350 template=almo_scf_env%matrix_k_blk(ispin))
3351 CALL dbcsr_set(step, 0.0_dp)
3352 CALL dbcsr_create(t_curr, &
3353 template=almo_scf_env%matrix_t(ispin))
3354 CALL dbcsr_create(sigma_oo_curr, &
3355 template=almo_scf_env%matrix_sigma(ispin), &
3356 matrix_type=dbcsr_type_no_symmetry)
3357 CALL dbcsr_create(sigma_oo_curr_inv, &
3358 template=almo_scf_env%matrix_sigma(ispin), &
3359 matrix_type=dbcsr_type_no_symmetry)
3360 CALL dbcsr_create(tmp1_n_vr, &
3361 template=almo_scf_env%matrix_v(ispin))
3362 CALL dbcsr_create(tmp3_vd_vr, &
3363 template=almo_scf_env%matrix_k_blk(ispin))
3364 CALL dbcsr_create(tmp2_n_o, &
3365 template=almo_scf_env%matrix_t(ispin))
3366 CALL dbcsr_create(tmp4_o_vr, &
3367 template=almo_scf_env%matrix_ov(ispin))
3368 CALL dbcsr_create(prev_grad, &
3369 template=almo_scf_env%matrix_k_blk(ispin))
3370 CALL dbcsr_set(prev_grad, 0.0_dp)
3371
3372 END IF ! done constructing discarded virtuals
3373
3374 ! init variables
3375 opt_k_max_iter = almo_scf_env%opt_k_max_iter
3376 iteration = 0
3377 converged = .false.
3378 prepare_to_exit = .false.
3379 beta = 0.0_dp
3380 line_search = .false.
3381 obj_function = 0.0_dp
3382 conjugacy_error = 0.0_dp
3383 line_search_error = 0.0_dp
3384 fun0 = 0.0_dp
3385 fun1 = 0.0_dp
3386 gfun0 = 0.0_dp
3387 gfun1 = 0.0_dp
3388 step_size_quadratic_approx = 0.0_dp
3389 reset_step_size = .true.
3390 IF (almo_scf_env%deloc_truncate_virt == virt_full) opt_k_max_iter = 0
3391
3392 ! start cg iterations to optimize matrix_k_blk
3393 DO
3394
3395 CALL timeset('k_opt_vr', handle1)
3396
3397 IF (almo_scf_env%deloc_truncate_virt /= virt_full) THEN
3398
3399 ! construct k-excited virtuals
3400 CALL dbcsr_multiply("N", "N", 1.0_dp, vd_fixed, &
3401 almo_scf_env%matrix_k_blk(ispin), &
3402 0.0_dp, almo_scf_env%matrix_v(ispin), &
3403 filter_eps=almo_scf_env%eps_filter)
3404 CALL dbcsr_add(almo_scf_env%matrix_v(ispin), vr_fixed, &
3405 +1.0_dp, +1.0_dp)
3406 END IF
3407
3408 ! decompose the overlap matrix of the current retained orbitals
3409 CALL get_overlap(bra=almo_scf_env%matrix_v(ispin), &
3410 ket=almo_scf_env%matrix_v(ispin), &
3411 overlap=almo_scf_env%matrix_sigma_vv(ispin), &
3412 metric=almo_scf_env%matrix_s(1), &
3413 retain_overlap_sparsity=.false., &
3414 eps_filter=almo_scf_env%eps_filter)
3415 ! use either cholesky or sqrt
3416 !! RZK-warning: strangely, cholesky does not work with k-optimization
3417 IF (almo_scf_env%deloc_truncate_virt == virt_full) THEN
3418 CALL timeset('cholesky', handle2)
3419 t1cholesky = m_walltime()
3420
3421 ! re-create sigma_vv_sqrt because desymmetrize is buggy -
3422 ! it will create multiple copies of blocks
3423 CALL dbcsr_create(sigma_vv_sqrt, &
3424 template=almo_scf_env%matrix_sigma_vv(ispin), &
3425 matrix_type=dbcsr_type_no_symmetry)
3426 CALL dbcsr_desymmetrize(almo_scf_env%matrix_sigma_vv(ispin), &
3427 sigma_vv_sqrt)
3428 CALL cp_dbcsr_cholesky_decompose(sigma_vv_sqrt, &
3429 para_env=almo_scf_env%para_env, &
3430 blacs_env=almo_scf_env%blacs_env)
3431 CALL make_triu(sigma_vv_sqrt)
3432 CALL dbcsr_filter(sigma_vv_sqrt, almo_scf_env%eps_filter)
3433 ! apply SOLVE to compute U^(-1) : U*U^(-1)=I
3434 CALL dbcsr_get_info(sigma_vv_sqrt, nfullrows_total=n)
3435 CALL dbcsr_create(matrix_tmp1, template=almo_scf_env%matrix_sigma_vv(ispin), &
3436 matrix_type=dbcsr_type_no_symmetry)
3437 CALL dbcsr_set(matrix_tmp1, 0.0_dp)
3438 CALL dbcsr_add_on_diag(matrix_tmp1, 1.0_dp)
3439 CALL cp_dbcsr_cholesky_restore(matrix_tmp1, n, sigma_vv_sqrt, &
3440 sigma_vv_sqrt_inv, op="SOLVE", pos="RIGHT", &
3441 para_env=almo_scf_env%para_env, &
3442 blacs_env=almo_scf_env%blacs_env)
3443 CALL dbcsr_filter(sigma_vv_sqrt_inv, almo_scf_env%eps_filter)
3444 CALL dbcsr_release(matrix_tmp1)
3445 IF (safe_mode) THEN
3446 CALL dbcsr_create(matrix_tmp1, template=almo_scf_env%matrix_sigma_vv(ispin), &
3447 matrix_type=dbcsr_type_no_symmetry)
3448 CALL dbcsr_desymmetrize(almo_scf_env%matrix_sigma_vv(ispin), &
3449 matrix_tmp1)
3450 CALL dbcsr_multiply("T", "N", 1.0_dp, sigma_vv_sqrt, &
3451 sigma_vv_sqrt, &
3452 -1.0_dp, matrix_tmp1, filter_eps=almo_scf_env%eps_filter)
3453 frob_matrix = dbcsr_frobenius_norm(matrix_tmp1)
3454 CALL dbcsr_add_on_diag(matrix_tmp1, 1.0_dp)
3455 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp1)
3456 IF (unit_nr > 0) THEN
3457 WRITE (unit_nr, *) "Error for ( U^T * U - Sig )", &
3458 frob_matrix/frob_matrix_base
3459 END IF
3460 CALL dbcsr_multiply("N", "N", 1.0_dp, sigma_vv_sqrt_inv, &
3461 sigma_vv_sqrt, &
3462 0.0_dp, matrix_tmp1, filter_eps=almo_scf_env%eps_filter)
3463 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp1)
3464 CALL dbcsr_add_on_diag(matrix_tmp1, -1.0_dp)
3465 frob_matrix = dbcsr_frobenius_norm(matrix_tmp1)
3466 IF (unit_nr > 0) THEN
3467 WRITE (unit_nr, *) "Error for ( inv(U) * U - I )", &
3468 frob_matrix/frob_matrix_base
3469 END IF
3470 CALL dbcsr_release(matrix_tmp1)
3471 END IF ! safe_mode
3472 t2cholesky = m_walltime()
3473 IF (unit_nr > 0) THEN
3474 WRITE (unit_nr, *) "Cholesky+inverse wall-time: ", t2cholesky - t1cholesky
3475 END IF
3476 CALL timestop(handle2)
3477 ELSE
3478 CALL matrix_sqrt_newton_schulz(sigma_vv_sqrt, &
3479 sigma_vv_sqrt_inv, &
3480 almo_scf_env%matrix_sigma_vv(ispin), &
3481 threshold=almo_scf_env%eps_filter, &
3482 order=almo_scf_env%order_lanczos, &
3483 eps_lanczos=almo_scf_env%eps_lanczos, &
3484 max_iter_lanczos=almo_scf_env%max_iter_lanczos)
3485 CALL dbcsr_copy(sigma_vv_sqrt_inv_guess, sigma_vv_sqrt_inv)
3486 CALL dbcsr_copy(sigma_vv_sqrt_guess, sigma_vv_sqrt)
3487 IF (safe_mode) THEN
3488 CALL dbcsr_create(matrix_tmp1, template=almo_scf_env%matrix_sigma_vv(ispin), &
3489 matrix_type=dbcsr_type_no_symmetry)
3490 CALL dbcsr_create(matrix_tmp2, template=almo_scf_env%matrix_sigma_vv(ispin), &
3491 matrix_type=dbcsr_type_no_symmetry)
3492
3493 CALL dbcsr_multiply("N", "N", 1.0_dp, sigma_vv_sqrt_inv, &
3494 almo_scf_env%matrix_sigma_vv(ispin), &
3495 0.0_dp, matrix_tmp1, filter_eps=almo_scf_env%eps_filter)
3496 CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_tmp1, &
3497 sigma_vv_sqrt_inv, &
3498 0.0_dp, matrix_tmp2, filter_eps=almo_scf_env%eps_filter)
3499
3500 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp2)
3501 CALL dbcsr_add_on_diag(matrix_tmp2, -1.0_dp)
3502 frob_matrix = dbcsr_frobenius_norm(matrix_tmp2)
3503 IF (unit_nr > 0) THEN
3504 WRITE (unit_nr, *) "Error for (inv(sqrt(SIGVV))*SIGVV*inv(sqrt(SIGVV))-I)", &
3505 frob_matrix/frob_matrix_base
3506 END IF
3507
3508 CALL dbcsr_release(matrix_tmp1)
3509 CALL dbcsr_release(matrix_tmp2)
3510 END IF
3511 END IF
3512 CALL timestop(handle1)
3513
3514 ! compute excitation amplitudes (to the current set of retained virtuals)
3515 ! set convergence criterion for x-optimization
3516 IF ((iteration == 0) .AND. (.NOT. line_search) .AND. &
3517 (outer_opt_k_iteration == 0)) THEN
3518 x_opt_eps_adaptive = &
3519 almo_scf_env%deloc_cayley_eps_convergence
3520 ELSE
3521 x_opt_eps_adaptive = &
3522 max(abs(almo_scf_env%deloc_cayley_eps_convergence), &
3523 abs(x_opt_eps_adaptive_factor*grad_norm))
3524 END IF
3525 CALL ct_step_env_init(ct_step_env)
3526 CALL ct_step_env_set(ct_step_env, &
3527 para_env=almo_scf_env%para_env, &
3528 blacs_env=almo_scf_env%blacs_env, &
3529 use_occ_orbs=.true., &
3530 use_virt_orbs=.true., &
3531 occ_orbs_orthogonal=.false., &
3532 virt_orbs_orthogonal=.false., &
3533 pp_preconditioner_full=almo_scf_env%deloc_cayley_occ_precond, &
3534 qq_preconditioner_full=almo_scf_env%deloc_cayley_vir_precond, &
3535 tensor_type=almo_scf_env%deloc_cayley_tensor_type, &
3536 neglect_quadratic_term=almo_scf_env%deloc_cayley_linear, &
3537 conjugator=almo_scf_env%deloc_cayley_conjugator, &
3538 max_iter=almo_scf_env%deloc_cayley_max_iter, &
3539 calculate_energy_corr=.true., &
3540 update_p=.false., &
3541 update_q=.false., &
3542 eps_convergence=x_opt_eps_adaptive, &
3543 eps_filter=almo_scf_env%eps_filter, &
3544 !nspins=1,&
3545 q_index_up=sigma_vv_sqrt_inv, &
3546 q_index_down=sigma_vv_sqrt, &
3547 p_index_up=almo_scf_env%matrix_sigma_sqrt_inv(ispin), &
3548 p_index_down=almo_scf_env%matrix_sigma_sqrt(ispin), &
3549 matrix_ks=almo_scf_env%matrix_ks_0deloc(ispin), &
3550 matrix_t=almo_scf_env%matrix_t(ispin), &
3551 matrix_qp_template=almo_scf_env%matrix_vo(ispin), &
3552 matrix_pq_template=almo_scf_env%matrix_ov(ispin), &
3553 matrix_v=almo_scf_env%matrix_v(ispin), &
3554 matrix_x_guess=almo_scf_env%matrix_x(ispin))
3555 ! perform calculations
3556 CALL ct_step_execute(ct_step_env)
3557 ! get the energy correction
3558 CALL ct_step_env_get(ct_step_env, &
3559 energy_correction=energy_correction(ispin), &
3560 copy_matrix_x=almo_scf_env%matrix_x(ispin))
3561 CALL ct_step_env_clean(ct_step_env)
3562 ! RZK-warning matrix_x is being transformed
3563 ! back and forth between orth and up_down representations
3564 energy_correction(1) = energy_correction(1)*spin_factor
3565
3566 IF (opt_k_max_iter /= 0) THEN
3567
3568 CALL timeset('k_opt_t_curr', handle3)
3569
3570 ! construct current occupied orbitals T_blk + V_r*X
3571 CALL dbcsr_multiply("N", "N", 1.0_dp, &
3572 almo_scf_env%matrix_v(ispin), &
3573 almo_scf_env%matrix_x(ispin), &
3574 0.0_dp, t_curr, &
3575 filter_eps=almo_scf_env%eps_filter)
3576 CALL dbcsr_add(t_curr, almo_scf_env%matrix_t_blk(ispin), &
3577 +1.0_dp, +1.0_dp)
3578
3579 ! calculate current occupied overlap
3580 CALL get_overlap(bra=t_curr, &
3581 ket=t_curr, &
3582 overlap=sigma_oo_curr, &
3583 metric=almo_scf_env%matrix_s(1), &
3584 retain_overlap_sparsity=.false., &
3585 eps_filter=almo_scf_env%eps_filter)
3586 IF (iteration == 0) THEN
3587 CALL invert_hotelling(sigma_oo_curr_inv, &
3588 sigma_oo_curr, &
3589 threshold=almo_scf_env%eps_filter, &
3590 use_inv_as_guess=.false.)
3591 ELSE
3592 CALL invert_hotelling(sigma_oo_curr_inv, &
3593 sigma_oo_curr, &
3594 threshold=almo_scf_env%eps_filter, &
3595 use_inv_as_guess=.true.)
3596 END IF
3597 IF (safe_mode) THEN
3598 CALL dbcsr_create(matrix_tmp1, template=sigma_oo_curr, &
3599 matrix_type=dbcsr_type_no_symmetry)
3600 CALL dbcsr_multiply("N", "N", 1.0_dp, sigma_oo_curr, &
3601 sigma_oo_curr_inv, &
3602 0.0_dp, matrix_tmp1, &
3603 filter_eps=almo_scf_env%eps_filter)
3604 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp1)
3605 CALL dbcsr_add_on_diag(matrix_tmp1, -1.0_dp)
3606 frob_matrix = dbcsr_frobenius_norm(matrix_tmp1)
3607 IF (unit_nr > 0) THEN
3608 WRITE (unit_nr, *) "Error for (SIG*inv(SIG)-I)", &
3609 frob_matrix/frob_matrix_base, frob_matrix_base
3610 END IF
3611 CALL dbcsr_release(matrix_tmp1)
3612 END IF
3613 IF (safe_mode) THEN
3614 CALL dbcsr_create(matrix_tmp1, template=sigma_oo_curr, &
3615 matrix_type=dbcsr_type_no_symmetry)
3616 CALL dbcsr_multiply("N", "N", 1.0_dp, sigma_oo_curr_inv, &
3617 sigma_oo_curr, &
3618 0.0_dp, matrix_tmp1, &
3619 filter_eps=almo_scf_env%eps_filter)
3620 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp1)
3621 CALL dbcsr_add_on_diag(matrix_tmp1, -1.0_dp)
3622 frob_matrix = dbcsr_frobenius_norm(matrix_tmp1)
3623 IF (unit_nr > 0) THEN
3624 WRITE (unit_nr, *) "Error for (inv(SIG)*SIG-I)", &
3625 frob_matrix/frob_matrix_base, frob_matrix_base
3626 END IF
3627 CALL dbcsr_release(matrix_tmp1)
3628 END IF
3629
3630 CALL timestop(handle3)
3631 CALL timeset('k_opt_vd', handle4)
3632
3633 ! construct current discarded virtuals:
3634 ! (1-R_curr)(1-Q^VR_curr)|ALMO_vd_basis> =
3635 ! = (1-Q^VR_curr)|ALMO_vd_basis>
3636 ! use sigma_vv_sqrt to store the inverse of the overlap
3637 ! sigma_vv_inv is computed from sqrt/cholesky
3638 CALL dbcsr_multiply("N", "T", 1.0_dp, &
3639 sigma_vv_sqrt_inv, &
3640 sigma_vv_sqrt_inv, &
3641 0.0_dp, sigma_vv_sqrt, &
3642 filter_eps=almo_scf_env%eps_filter)
3643 CALL apply_projector(psi_in=almo_scf_env%matrix_v_disc_blk(ispin), &
3644 psi_out=almo_scf_env%matrix_v_disc(ispin), &
3645 psi_projector=almo_scf_env%matrix_v(ispin), &
3646 metric=almo_scf_env%matrix_s(1), &
3647 project_out=.false., &
3648 psi_projector_orthogonal=.false., &
3649 proj_in_template=almo_scf_env%matrix_k_tr(ispin), &
3650 eps_filter=almo_scf_env%eps_filter, &
3651 sig_inv_projector=sigma_vv_sqrt)
3652 !sig_inv_template=almo_scf_env%matrix_sigma_vv(ispin),&
3653 CALL dbcsr_add(almo_scf_env%matrix_v_disc(ispin), &
3654 vd_fixed, -1.0_dp, +1.0_dp)
3655
3656 CALL timestop(handle4)
3657 CALL timeset('k_opt_grad', handle5)
3658
3659 ! evaluate the gradient from the assembled components
3660 ! grad_xx = c0 [ (Vd_curr^tr)*F*T_curr*sigma_oo_curr_inv*(X^tr)]_xx
3661 ! save previous gradient to calculate conjugation coef
3662 IF (line_search) THEN
3663 CALL dbcsr_copy(prev_grad, grad)
3664 END IF
3665 CALL dbcsr_multiply("N", "N", 1.0_dp, &
3666 almo_scf_env%matrix_ks_0deloc(ispin), &
3667 t_curr, &
3668 0.0_dp, tmp2_n_o, &
3669 filter_eps=almo_scf_env%eps_filter)
3670 CALL dbcsr_multiply("N", "T", 1.0_dp, &
3671 sigma_oo_curr_inv, &
3672 almo_scf_env%matrix_x(ispin), &
3673 0.0_dp, tmp4_o_vr, &
3674 filter_eps=almo_scf_env%eps_filter)
3675 CALL dbcsr_multiply("N", "N", 1.0_dp, &
3676 tmp2_n_o, &
3677 tmp4_o_vr, &
3678 0.0_dp, tmp1_n_vr, &
3679 filter_eps=almo_scf_env%eps_filter)
3680 CALL dbcsr_multiply("T", "N", 2.0_dp*spin_factor, &
3681 almo_scf_env%matrix_v_disc(ispin), &
3682 tmp1_n_vr, &
3683 0.0_dp, grad, &
3684 retain_sparsity=.true.)
3685 ! keep tmp2_n_o for the next step
3686 ! keep tmp4_o_vr for the preconditioner
3687
3688 ! check convergence and other exit criteria
3689 grad_norm_frob = dbcsr_frobenius_norm(grad)
3690 grad_norm = dbcsr_maxabs(grad)
3691 converged = (grad_norm < almo_scf_env%opt_k_eps_convergence)
3692 IF (converged .OR. (iteration >= opt_k_max_iter)) THEN
3693 prepare_to_exit = .true.
3694 END IF
3695 CALL timestop(handle5)
3696
3697 IF (.NOT. prepare_to_exit) THEN
3698
3699 CALL timeset('k_opt_energy', handle6)
3700
3701 ! compute "energy" c0*Tr[sig_inv_oo*t*F*t]
3702 CALL dbcsr_multiply("T", "N", spin_factor, &
3703 t_curr, &
3704 tmp2_n_o, &
3705 0.0_dp, sigma_oo_curr, &
3706 filter_eps=almo_scf_env%eps_filter)
3707 delta_obj_function = fun0
3708 CALL dbcsr_dot(sigma_oo_curr_inv, sigma_oo_curr, obj_function)
3709 delta_obj_function = obj_function - delta_obj_function
3710 IF (line_search) THEN
3711 fun1 = obj_function
3712 ELSE
3713 fun0 = obj_function
3714 END IF
3715
3716 CALL timestop(handle6)
3717
3718 ! update the step direction
3719 IF (.NOT. line_search) THEN
3720
3721 CALL timeset('k_opt_step', handle7)
3722
3723 IF ((.NOT. md_in_k_space) .AND. &
3724 (iteration >= max(0, almo_scf_env%opt_k_prec_iter_start) .AND. &
3725 mod(iteration - almo_scf_env%opt_k_prec_iter_start, &
3726 almo_scf_env%opt_k_prec_iter_freq) == 0)) THEN
3727
3728 !IF ((iteration.eq.0).AND.(.NOT.md_in_k_space)) THEN
3729
3730 ! compute the preconditioner
3731 IF (unit_nr > 0) THEN
3732 WRITE (unit_nr, *) "Computing preconditioner"
3733 END IF
3734 CALL opt_k_create_preconditioner_blk(almo_scf_env, &
3735 almo_scf_env%matrix_v_disc(ispin), &
3736 tmp4_o_vr, &
3737 t_curr, &
3738 ispin, &
3739 spin_factor)
3740
3741 END IF
3742
3743 ! save the previous step
3744 CALL dbcsr_copy(prev_step, step)
3745
3746 ! compute the new step
3747 CALL opt_k_apply_preconditioner_blk(almo_scf_env, &
3748 step, grad, ispin)
3749 CALL dbcsr_scale(step, -1.0_dp)
3750
3751 ! check whether we need to reset conjugate directions
3752 reset_conjugator = .false.
3753 ! first check if manual reset is active
3754 IF (iteration < max(almo_scf_env%opt_k_conj_iter_start, 1) .OR. &
3755 mod(iteration - almo_scf_env%opt_k_conj_iter_start, &
3756 almo_scf_env%opt_k_conj_iter_freq) == 0) THEN
3757
3758 reset_conjugator = .true.
3759
3760 ELSE
3761
3762 ! check for the errors in the cg algorithm
3763 CALL dbcsr_dot(grad, prev_minus_prec_grad, numer)
3764 CALL dbcsr_dot(prev_grad, prev_minus_prec_grad, denom)
3765 conjugacy_error = numer/denom
3766
3767 IF (conjugacy_error > min(0.5_dp, conjugacy_error_threshold)) THEN
3768 reset_conjugator = .true.
3769 IF (unit_nr > 0) THEN
3770 WRITE (unit_nr, *) "Lack of progress, conjugacy error is ", conjugacy_error
3771 END IF
3772 END IF
3773
3774 ! check the gradient along the previous direction
3775 IF ((iteration /= 0) .AND. (.NOT. reset_conjugator)) THEN
3776 CALL dbcsr_dot(grad, prev_step, numer)
3777 CALL dbcsr_dot(prev_grad, prev_step, denom)
3778 line_search_error = numer/denom
3779 IF (line_search_error > line_search_error_threshold) THEN
3780 reset_conjugator = .true.
3781 IF (unit_nr > 0) THEN
3782 WRITE (unit_nr, *) "Bad line search, line search error is ", line_search_error
3783 END IF
3784 END IF
3785 END IF
3786
3787 END IF
3788
3789 ! compute the conjugation coefficient - beta
3790 IF (.NOT. reset_conjugator) THEN
3791
3792 SELECT CASE (almo_scf_env%opt_k_conjugator)
3793 CASE (cg_hestenes_stiefel)
3794 CALL dbcsr_copy(tmp_k_blk, grad)
3795 CALL dbcsr_add(tmp_k_blk, prev_grad, 1.0_dp, -1.0_dp)
3796 CALL dbcsr_dot(tmp_k_blk, step, numer)
3797 CALL dbcsr_dot(tmp_k_blk, prev_step, denom)
3798 beta = -1.0_dp*numer/denom
3799 CASE (cg_fletcher_reeves)
3800 CALL dbcsr_dot(grad, step, numer)
3801 CALL dbcsr_dot(prev_grad, prev_minus_prec_grad, denom)
3802 beta = numer/denom
3803 CASE (cg_polak_ribiere)
3804 CALL dbcsr_dot(prev_grad, prev_minus_prec_grad, denom)
3805 CALL dbcsr_copy(tmp_k_blk, grad)
3806 CALL dbcsr_add(tmp_k_blk, prev_grad, 1.0_dp, -1.0_dp)
3807 CALL dbcsr_dot(tmp_k_blk, step, numer)
3808 beta = numer/denom
3809 CASE (cg_fletcher)
3810 CALL dbcsr_dot(grad, step, numer)
3811 CALL dbcsr_dot(prev_grad, prev_step, denom)
3812 beta = numer/denom
3813 CASE (cg_liu_storey)
3814 CALL dbcsr_dot(prev_grad, prev_step, denom)
3815 CALL dbcsr_copy(tmp_k_blk, grad)
3816 CALL dbcsr_add(tmp_k_blk, prev_grad, 1.0_dp, -1.0_dp)
3817 CALL dbcsr_dot(tmp_k_blk, step, numer)
3818 beta = numer/denom
3819 CASE (cg_dai_yuan)
3820 CALL dbcsr_dot(grad, step, numer)
3821 CALL dbcsr_copy(tmp_k_blk, grad)
3822 CALL dbcsr_add(tmp_k_blk, prev_grad, 1.0_dp, -1.0_dp)
3823 CALL dbcsr_dot(tmp_k_blk, prev_step, denom)
3824 beta = -1.0_dp*numer/denom
3825 CASE (cg_hager_zhang)
3826 CALL dbcsr_copy(tmp_k_blk, grad)
3827 CALL dbcsr_add(tmp_k_blk, prev_grad, 1.0_dp, -1.0_dp)
3828 CALL dbcsr_dot(tmp_k_blk, prev_step, denom)
3829 CALL dbcsr_dot(tmp_k_blk, prev_minus_prec_grad, numer)
3830 kappa = -2.0_dp*numer/denom
3831 CALL dbcsr_dot(tmp_k_blk, step, numer)
3832 tau = -1.0_dp*numer/denom
3833 CALL dbcsr_dot(prev_step, grad, numer)
3834 beta = tau - kappa*numer/denom
3835 CASE (cg_zero)
3836 beta = 0.0_dp
3837 CASE DEFAULT
3838 cpabort("illegal conjugator")
3839 END SELECT
3840
3841 IF (beta < 0.0_dp) THEN
3842 IF (unit_nr > 0) THEN
3843 WRITE (unit_nr, *) "Beta is negative, ", beta
3844 END IF
3845 reset_conjugator = .true.
3846 END IF
3847
3848 END IF
3849
3850 IF (md_in_k_space) THEN
3851 reset_conjugator = .true.
3852 END IF
3853
3854 IF (reset_conjugator) THEN
3855
3856 beta = 0.0_dp
3857
3858 IF (unit_nr > 0) THEN
3859 WRITE (unit_nr, *) "(Re)-setting conjugator to zero"
3860 END IF
3861
3862 END IF
3863
3864 ! save the preconditioned gradient
3865 CALL dbcsr_copy(prev_minus_prec_grad, step)
3866
3867 ! conjugate the step direction
3868 CALL dbcsr_add(step, prev_step, 1.0_dp, beta)
3869
3870 CALL timestop(handle7)
3871
3872 ! update the step direction
3873 ELSE ! step update
3874 conjugacy_error = 0.0_dp
3875 END IF
3876
3877 ! compute the gradient with respect to the step size in the curr direction
3878 IF (line_search) THEN
3879 CALL dbcsr_dot(grad, step, gfun1)
3880 line_search_error = gfun1/gfun0
3881 ELSE
3882 CALL dbcsr_dot(grad, step, gfun0)
3883 END IF
3884
3885 ! make a step - update k
3886 IF (line_search) THEN
3887
3888 ! check if the trial step provides enough numerical accuracy
3889 safety_multiplier = 1.0e+1_dp ! must be more than one
3890 num_threshold = max(epsilon(1.0_dp), &
3891 safety_multiplier*(almo_scf_env%eps_filter**2)*almo_scf_env%ndomains)
3892 IF (abs(fun1 - fun0 - gfun0*step_size) < num_threshold) THEN
3893 IF (unit_nr > 0) THEN
3894 WRITE (unit_nr, '(T3,A,1X,E17.7)') &
3895 "Numerical accuracy is too low to observe non-linear behavior", &
3896 abs(fun1 - fun0 - gfun0*step_size)
3897 WRITE (unit_nr, '(T3,A,1X,E17.7,A,1X,E12.3)') "Error computing ", &
3898 abs(gfun0), &
3899 " is smaller than the threshold", num_threshold
3900 END IF
3901 cpabort("Unable to continue with low numerical accuracy")
3902 END IF
3903 IF (abs(gfun0) < num_threshold) THEN
3904 IF (unit_nr > 0) THEN
3905 WRITE (unit_nr, '(T3,A,1X,E17.7,A,1X,E12.3)') "Linear gradient", &
3906 abs(gfun0), &
3907 " is smaller than the threshold", num_threshold
3908 END IF
3909 cpabort("Unable to continue with low numerical accuracy")
3910 END IF
3911
3912 use_quadratic_approximation = .true.
3913 use_cubic_approximation = .false.
3914
3915 ! find the minimum assuming quadratic form
3916 ! use f0, f1, g0
3917 step_size_quadratic_approx = -(gfun0*step_size*step_size)/(2.0_dp*(fun1 - fun0 - gfun0*step_size))
3918 ! use f0, f1, g1
3919 step_size_quadratic_approx2 = -(fun1 - fun0 - step_size*gfun1/2.0_dp)/(gfun1 - (fun1 - fun0)/step_size)
3920
3921 IF ((step_size_quadratic_approx < 0.0_dp) .AND. &
3922 (step_size_quadratic_approx2 < 0.0_dp)) THEN
3923 IF (unit_nr > 0) THEN
3924 WRITE (unit_nr, '(T3,A,1X,E17.7,1X,E17.7,1X,A)') &
3925 "Quadratic approximation gives negative steps", &
3926 step_size_quadratic_approx, step_size_quadratic_approx2, &
3927 "trying cubic..."
3928 END IF
3929 use_cubic_approximation = .true.
3930 use_quadratic_approximation = .false.
3931 ELSE
3932 IF (step_size_quadratic_approx < 0.0_dp) THEN
3933 step_size_quadratic_approx = step_size_quadratic_approx2
3934 END IF
3935 IF (step_size_quadratic_approx2 < 0.0_dp) THEN
3936 step_size_quadratic_approx2 = step_size_quadratic_approx
3937 END IF
3938 END IF
3939
3940 ! check accuracy of the quadratic approximation
3941 IF (use_quadratic_approximation) THEN
3942 quadratic_approx_error = abs(step_size_quadratic_approx - &
3943 step_size_quadratic_approx2)/step_size_quadratic_approx
3944 IF (quadratic_approx_error > quadratic_approx_error_threshold) THEN
3945 IF (unit_nr > 0) THEN
3946 WRITE (unit_nr, '(T3,A,1X,E17.7,1X,E17.7,1X,A)') "Quadratic approximation is poor", &
3947 step_size_quadratic_approx, step_size_quadratic_approx2, &
3948 "Try cubic approximation"
3949 END IF
3950 use_cubic_approximation = .true.
3951 use_quadratic_approximation = .false.
3952 END IF
3953 END IF
3954
3955 ! check if numerics is fine enough to capture the cubic form
3956 IF (use_cubic_approximation) THEN
3957
3958 ! if quadratic approximation is not accurate enough
3959 ! try to find the minimum assuming cubic form
3960 ! aa*x**3 + bb*x**2 + cc*x + dd = f(x)
3961 bb = (-step_size*gfun1 + 3.0_dp*(fun1 - fun0) - 2.0_dp*step_size*gfun0)/(step_size*step_size)
3962 aa = (gfun1 - 2.0_dp*step_size*bb - gfun0)/(3.0_dp*step_size*step_size)
3963
3964 IF (abs(gfun1 - 2.0_dp*step_size*bb - gfun0) < num_threshold) THEN
3965 IF (unit_nr > 0) THEN
3966 WRITE (unit_nr, '(T3,A,1X,E17.7)') &
3967 "Numerical accuracy is too low to observe cubic behavior", &
3968 abs(gfun1 - 2.0_dp*step_size*bb - gfun0)
3969 END IF
3970 use_cubic_approximation = .false.
3971 use_quadratic_approximation = .true.
3972 END IF
3973 IF (abs(gfun1) < num_threshold) THEN
3974 IF (unit_nr > 0) THEN
3975 WRITE (unit_nr, '(T3,A,1X,E17.7,A,1X,E12.3)') "Linear gradient", &
3976 abs(gfun1), &
3977 " is smaller than the threshold", num_threshold
3978 END IF
3979 use_cubic_approximation = .false.
3980 use_quadratic_approximation = .true.
3981 END IF
3982 END IF
3983
3984 ! find the step assuming cubic approximation
3985 IF (use_cubic_approximation) THEN
3986 ! to obtain the minimum of the cubic function solve the quadratic equation
3987 ! 0.0*x**3 + 3.0*aa*x**2 + 2.0*bb*x + cc = 0
3988 CALL analytic_line_search(0.0_dp, 3.0_dp*aa, 2.0_dp*bb, gfun0, minima, nmins)
3989 IF (nmins < 1) THEN
3990 IF (unit_nr > 0) THEN
3991 WRITE (unit_nr, '(T3,A)') &
3992 "Cubic approximation gives zero soultions! Use quadratic approximation"
3993 END IF
3994 use_quadratic_approximation = .true.
3995 use_cubic_approximation = .true.
3996 ELSE
3997 step_size = minima(1)
3998 IF (nmins > 1) THEN
3999 IF (unit_nr > 0) THEN
4000 WRITE (unit_nr, '(T3,A)') &
4001 "More than one solution found! Use quadratic approximation"
4002 END IF
4003 use_quadratic_approximation = .true.
4004 use_cubic_approximation = .true.
4005 END IF
4006 END IF
4007 END IF
4008
4009 IF (use_quadratic_approximation) THEN ! use quadratic approximation
4010 IF (unit_nr > 0) THEN
4011 WRITE (unit_nr, '(T3,A)') "Use quadratic approximation"
4012 END IF
4013 step_size = (step_size_quadratic_approx + step_size_quadratic_approx2)*0.5_dp
4014 END IF
4015
4016 ! one more check on the step size
4017 IF (step_size < 0.0_dp) THEN
4018 cpabort("Negative step proposed")
4019 END IF
4020
4021 CALL dbcsr_copy(almo_scf_env%matrix_k_blk(ispin), &
4022 matrix_k_central)
4023 CALL dbcsr_add(almo_scf_env%matrix_k_blk(ispin), &
4024 step, 1.0_dp, step_size)
4025 CALL dbcsr_copy(matrix_k_central, &
4026 almo_scf_env%matrix_k_blk(ispin))
4027 line_search = .false.
4028
4029 ELSE
4030
4031 IF (md_in_k_space) THEN
4032
4033 ! update velocities v(i) = v(i-1) + 0.5*dT*(a(i-1) + a(i))
4034 IF (iteration /= 0) THEN
4035 CALL dbcsr_add(velocity, &
4036 step, 1.0_dp, 0.5_dp*time_step)
4037 CALL dbcsr_add(velocity, &
4038 prev_step, 1.0_dp, 0.5_dp*time_step)
4039 END IF
4040 kin_energy = dbcsr_frobenius_norm(velocity)
4041 kin_energy = 0.5_dp*kin_energy*kin_energy
4042
4043 ! update positions k(i) = k(i-1) + dT*v(i-1) + 0.5*dT*dT*a(i-1)
4044 CALL dbcsr_add(almo_scf_env%matrix_k_blk(ispin), &
4045 velocity, 1.0_dp, time_step)
4046 CALL dbcsr_add(almo_scf_env%matrix_k_blk(ispin), &
4047 step, 1.0_dp, 0.5_dp*time_step*time_step)
4048
4049 ELSE
4050
4051 IF (reset_step_size) THEN
4052 step_size = almo_scf_env%opt_k_trial_step_size
4053 reset_step_size = .false.
4054 ELSE
4055 step_size = step_size*almo_scf_env%opt_k_trial_step_size_multiplier
4056 END IF
4057 CALL dbcsr_copy(almo_scf_env%matrix_k_blk(ispin), &
4058 matrix_k_central)
4059 CALL dbcsr_add(almo_scf_env%matrix_k_blk(ispin), &
4060 step, 1.0_dp, step_size)
4061 line_search = .true.
4062 END IF
4063
4064 END IF
4065
4066 END IF ! .NOT.prepare_to_exit
4067
4068 ! print the status of the optimization
4069 t2a = m_walltime()
4070 IF (unit_nr > 0) THEN
4071 IF (md_in_k_space) THEN
4072 WRITE (unit_nr, '(T6,A,1X,I5,1X,E12.3,E16.7,F15.9,F15.9,F15.9,E12.3,F15.9,F15.9,F8.3)') &
4073 "K iter CG", iteration, time_step, time_step*iteration, &
4074 energy_correction(ispin), obj_function, delta_obj_function, grad_norm, &
4075 kin_energy, kin_energy + obj_function, beta
4076 ELSE
4077 IF (line_search .OR. prepare_to_exit) THEN
4078 WRITE (unit_nr, '(T6,A,1X,I3,1X,E12.3,F16.10,F16.10,E12.3,E12.3,E12.3,F8.3,F8.3,F10.3)') &
4079 "K iter CG", iteration, step_size, &
4080 energy_correction(ispin), delta_obj_function, grad_norm, &
4081 gfun0, line_search_error, beta, conjugacy_error, t2a - t1a
4082 ELSE
4083 WRITE (unit_nr, '(T6,A,1X,I3,1X,E12.3,F16.10,F16.10,E12.3,E12.3,E12.3,F8.3,F8.3,F10.3)') &
4084 "K iter LS", iteration, step_size, &
4085 energy_correction(ispin), delta_obj_function, grad_norm, &
4086 gfun1, line_search_error, beta, conjugacy_error, t2a - t1a
4087 END IF
4088 END IF
4089 CALL m_flush(unit_nr)
4090 END IF
4091 t1a = m_walltime()
4092
4093 ELSE ! opt_k_max_iter .eq. 0
4094 prepare_to_exit = .true.
4095 END IF ! opt_k_max_iter .ne. 0
4096
4097 IF (.NOT. line_search) iteration = iteration + 1
4098
4099 IF (prepare_to_exit) EXIT
4100
4101 END DO ! end iterations on K
4102
4103 IF (converged .OR. (outer_opt_k_iteration >= outer_opt_k_max_iter)) THEN
4104 outer_opt_k_prepare_to_exit = .true.
4105 END IF
4106
4107 IF (almo_scf_env%deloc_truncate_virt /= virt_full) THEN
4108
4109 IF (unit_nr > 0) THEN
4110 WRITE (unit_nr, *) "Updating ALMO virtuals"
4111 END IF
4112
4113 CALL timeset('k_opt_v0_update', handle8)
4114
4115 ! update retained ALMO virtuals to restart the cg iterations
4116 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4117 almo_scf_env%matrix_v_disc_blk(ispin), &
4118 almo_scf_env%matrix_k_blk(ispin), &
4119 0.0_dp, vr_fixed, &
4120 filter_eps=almo_scf_env%eps_filter)
4121 CALL dbcsr_add(vr_fixed, almo_scf_env%matrix_v_blk(ispin), &
4122 +1.0_dp, +1.0_dp)
4123
4124 ! update discarded ALMO virtuals to restart the cg iterations
4125 CALL dbcsr_multiply("N", "T", 1.0_dp, &
4126 almo_scf_env%matrix_v_blk(ispin), &
4127 almo_scf_env%matrix_k_blk(ispin), &
4128 0.0_dp, vd_fixed, &
4129 filter_eps=almo_scf_env%eps_filter)
4130 CALL dbcsr_add(vd_fixed, almo_scf_env%matrix_v_disc_blk(ispin), &
4131 -1.0_dp, +1.0_dp)
4132
4133 ! orthogonalize new orbitals on fragments
4134 CALL get_overlap(bra=vr_fixed, &
4135 ket=vr_fixed, &
4136 overlap=k_vr_index_down, &
4137 metric=almo_scf_env%matrix_s_blk(1), &
4138 retain_overlap_sparsity=.false., &
4139 eps_filter=almo_scf_env%eps_filter)
4140 CALL dbcsr_create(vr_index_sqrt_inv, template=k_vr_index_down, &
4141 matrix_type=dbcsr_type_no_symmetry)
4142 CALL dbcsr_create(vr_index_sqrt, template=k_vr_index_down, &
4143 matrix_type=dbcsr_type_no_symmetry)
4144 CALL matrix_sqrt_newton_schulz(vr_index_sqrt, &
4145 vr_index_sqrt_inv, &
4146 k_vr_index_down, &
4147 threshold=almo_scf_env%eps_filter, &
4148 order=almo_scf_env%order_lanczos, &
4149 eps_lanczos=almo_scf_env%eps_lanczos, &
4150 max_iter_lanczos=almo_scf_env%max_iter_lanczos)
4151 IF (safe_mode) THEN
4152 CALL dbcsr_create(matrix_tmp1, template=k_vr_index_down, &
4153 matrix_type=dbcsr_type_no_symmetry)
4154 CALL dbcsr_create(matrix_tmp2, template=k_vr_index_down, &
4155 matrix_type=dbcsr_type_no_symmetry)
4156
4157 CALL dbcsr_multiply("N", "N", 1.0_dp, vr_index_sqrt_inv, &
4158 k_vr_index_down, &
4159 0.0_dp, matrix_tmp1, filter_eps=almo_scf_env%eps_filter)
4160 CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_tmp1, &
4161 vr_index_sqrt_inv, &
4162 0.0_dp, matrix_tmp2, filter_eps=almo_scf_env%eps_filter)
4163
4164 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp2)
4165 CALL dbcsr_add_on_diag(matrix_tmp2, -1.0_dp)
4166 frob_matrix = dbcsr_frobenius_norm(matrix_tmp2)
4167 IF (unit_nr > 0) THEN
4168 WRITE (unit_nr, *) "Error for (inv(sqrt(SIGVV))*SIGVV*inv(sqrt(SIGVV))-I)", &
4169 frob_matrix/frob_matrix_base
4170 END IF
4171
4172 CALL dbcsr_release(matrix_tmp1)
4173 CALL dbcsr_release(matrix_tmp2)
4174 END IF
4175 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4176 vr_fixed, &
4177 vr_index_sqrt_inv, &
4178 0.0_dp, almo_scf_env%matrix_v_blk(ispin), &
4179 filter_eps=almo_scf_env%eps_filter)
4180
4181 CALL get_overlap(bra=vd_fixed, &
4182 ket=vd_fixed, &
4183 overlap=k_vd_index_down, &
4184 metric=almo_scf_env%matrix_s_blk(1), &
4185 retain_overlap_sparsity=.false., &
4186 eps_filter=almo_scf_env%eps_filter)
4187 CALL dbcsr_create(vd_index_sqrt_inv, template=k_vd_index_down, &
4188 matrix_type=dbcsr_type_no_symmetry)
4189 CALL dbcsr_create(vd_index_sqrt, template=k_vd_index_down, &
4190 matrix_type=dbcsr_type_no_symmetry)
4191 CALL matrix_sqrt_newton_schulz(vd_index_sqrt, &
4192 vd_index_sqrt_inv, &
4193 k_vd_index_down, &
4194 threshold=almo_scf_env%eps_filter, &
4195 order=almo_scf_env%order_lanczos, &
4196 eps_lanczos=almo_scf_env%eps_lanczos, &
4197 max_iter_lanczos=almo_scf_env%max_iter_lanczos)
4198 IF (safe_mode) THEN
4199 CALL dbcsr_create(matrix_tmp1, template=k_vd_index_down, &
4200 matrix_type=dbcsr_type_no_symmetry)
4201 CALL dbcsr_create(matrix_tmp2, template=k_vd_index_down, &
4202 matrix_type=dbcsr_type_no_symmetry)
4203
4204 CALL dbcsr_multiply("N", "N", 1.0_dp, vd_index_sqrt_inv, &
4205 k_vd_index_down, &
4206 0.0_dp, matrix_tmp1, filter_eps=almo_scf_env%eps_filter)
4207 CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_tmp1, &
4208 vd_index_sqrt_inv, &
4209 0.0_dp, matrix_tmp2, filter_eps=almo_scf_env%eps_filter)
4210
4211 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp2)
4212 CALL dbcsr_add_on_diag(matrix_tmp2, -1.0_dp)
4213 frob_matrix = dbcsr_frobenius_norm(matrix_tmp2)
4214 IF (unit_nr > 0) THEN
4215 WRITE (unit_nr, *) "Error for (inv(sqrt(SIGVV))*SIGVV*inv(sqrt(SIGVV))-I)", &
4216 frob_matrix/frob_matrix_base
4217 END IF
4218
4219 CALL dbcsr_release(matrix_tmp1)
4220 CALL dbcsr_release(matrix_tmp2)
4221 END IF
4222 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4223 vd_fixed, &
4224 vd_index_sqrt_inv, &
4225 0.0_dp, almo_scf_env%matrix_v_disc_blk(ispin), &
4226 filter_eps=almo_scf_env%eps_filter)
4227
4228 CALL dbcsr_release(vr_index_sqrt_inv)
4229 CALL dbcsr_release(vr_index_sqrt)
4230 CALL dbcsr_release(vd_index_sqrt_inv)
4231 CALL dbcsr_release(vd_index_sqrt)
4232
4233 CALL timestop(handle8)
4234
4235 END IF ! ne.virt_full
4236
4237 ! RZK-warning released outside the outer loop
4238 CALL dbcsr_release(sigma_vv_sqrt)
4239 CALL dbcsr_release(sigma_vv_sqrt_inv)
4240 IF (almo_scf_env%deloc_truncate_virt /= virt_full) THEN
4241 CALL dbcsr_release(k_vr_index_down)
4242 CALL dbcsr_release(k_vd_index_down)
4243 CALL dbcsr_release(matrix_k_central)
4244 CALL dbcsr_release(vr_fixed)
4245 CALL dbcsr_release(vd_fixed)
4246 CALL dbcsr_release(grad)
4247 CALL dbcsr_release(prec)
4248 CALL dbcsr_release(prev_grad)
4249 CALL dbcsr_release(tmp3_vd_vr)
4250 CALL dbcsr_release(tmp1_n_vr)
4251 CALL dbcsr_release(tmp_k_blk)
4252 CALL dbcsr_release(t_curr)
4253 CALL dbcsr_release(sigma_oo_curr)
4254 CALL dbcsr_release(sigma_oo_curr_inv)
4255 CALL dbcsr_release(step)
4256 CALL dbcsr_release(tmp2_n_o)
4257 CALL dbcsr_release(tmp4_o_vr)
4258 CALL dbcsr_release(prev_step)
4259 CALL dbcsr_release(prev_minus_prec_grad)
4260 IF (md_in_k_space) THEN
4261 CALL dbcsr_release(velocity)
4262 END IF
4263
4264 END IF
4265
4266 outer_opt_k_iteration = outer_opt_k_iteration + 1
4267 IF (outer_opt_k_prepare_to_exit) EXIT
4268
4269 END DO ! outer loop for k
4270
4271 END DO ! ispin
4272
4273 ! RZK-warning update mo orbitals
4274
4275 ELSE ! virtual orbitals might not be available use projected AOs
4276
4277 ! compute sqrt(S) and inv(sqrt(S))
4278 ! RZK-warning - remove this sqrt(S) and inv(sqrt(S))
4279 ! ideally ALMO scf should use sigma and sigma_inv in
4280 ! the tensor_up_down representation
4281 IF (.NOT. almo_scf_env%s_sqrt_done) THEN
4282
4283 IF (unit_nr > 0) THEN
4284 WRITE (unit_nr, *) "sqrt and inv(sqrt) of AO overlap matrix"
4285 END IF
4286 CALL dbcsr_create(almo_scf_env%matrix_s_sqrt(1), &
4287 template=almo_scf_env%matrix_s(1), &
4288 matrix_type=dbcsr_type_no_symmetry)
4289 CALL dbcsr_create(almo_scf_env%matrix_s_sqrt_inv(1), &
4290 template=almo_scf_env%matrix_s(1), &
4291 matrix_type=dbcsr_type_no_symmetry)
4292
4293 CALL matrix_sqrt_newton_schulz(almo_scf_env%matrix_s_sqrt(1), &
4294 almo_scf_env%matrix_s_sqrt_inv(1), &
4295 almo_scf_env%matrix_s(1), &
4296 threshold=almo_scf_env%eps_filter, &
4297 order=almo_scf_env%order_lanczos, &
4298 eps_lanczos=almo_scf_env%eps_lanczos, &
4299 max_iter_lanczos=almo_scf_env%max_iter_lanczos)
4300
4301 IF (safe_mode) THEN
4302 CALL dbcsr_create(matrix_tmp1, template=almo_scf_env%matrix_s(1), &
4303 matrix_type=dbcsr_type_no_symmetry)
4304 CALL dbcsr_create(matrix_tmp2, template=almo_scf_env%matrix_s(1), &
4305 matrix_type=dbcsr_type_no_symmetry)
4306
4307 CALL dbcsr_multiply("N", "N", 1.0_dp, almo_scf_env%matrix_s_sqrt_inv(1), &
4308 almo_scf_env%matrix_s(1), &
4309 0.0_dp, matrix_tmp1, filter_eps=almo_scf_env%eps_filter)
4310 CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_tmp1, almo_scf_env%matrix_s_sqrt_inv(1), &
4311 0.0_dp, matrix_tmp2, filter_eps=almo_scf_env%eps_filter)
4312
4313 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp2)
4314 CALL dbcsr_add_on_diag(matrix_tmp2, -1.0_dp)
4315 frob_matrix = dbcsr_frobenius_norm(matrix_tmp2)
4316 IF (unit_nr > 0) THEN
4317 WRITE (unit_nr, *) "Error for (inv(sqrt(S))*S*inv(sqrt(S))-I)", frob_matrix/frob_matrix_base
4318 END IF
4319
4320 CALL dbcsr_release(matrix_tmp1)
4321 CALL dbcsr_release(matrix_tmp2)
4322 END IF
4323
4324 almo_scf_env%s_sqrt_done = .true.
4325
4326 END IF
4327
4328 DO ispin = 1, nspin
4329
4330 CALL ct_step_env_init(ct_step_env)
4331 CALL ct_step_env_set(ct_step_env, &
4332 para_env=almo_scf_env%para_env, &
4333 blacs_env=almo_scf_env%blacs_env, &
4334 use_occ_orbs=.true., &
4335 use_virt_orbs=almo_scf_env%deloc_cayley_use_virt_orbs, &
4336 occ_orbs_orthogonal=.false., &
4337 virt_orbs_orthogonal=almo_scf_env%orthogonal_basis, &
4338 tensor_type=almo_scf_env%deloc_cayley_tensor_type, &
4339 neglect_quadratic_term=almo_scf_env%deloc_cayley_linear, &
4340 calculate_energy_corr=.true., &
4341 update_p=.true., &
4342 update_q=.false., &
4343 pp_preconditioner_full=almo_scf_env%deloc_cayley_occ_precond, &
4344 qq_preconditioner_full=almo_scf_env%deloc_cayley_vir_precond, &
4345 eps_convergence=almo_scf_env%deloc_cayley_eps_convergence, &
4346 eps_filter=almo_scf_env%eps_filter, &
4347 !nspins=almo_scf_env%nspins,&
4348 q_index_up=almo_scf_env%matrix_s_sqrt_inv(1), &
4349 q_index_down=almo_scf_env%matrix_s_sqrt(1), &
4350 p_index_up=almo_scf_env%matrix_sigma_sqrt_inv(ispin), &
4351 p_index_down=almo_scf_env%matrix_sigma_sqrt(ispin), &
4352 matrix_ks=almo_scf_env%matrix_ks_0deloc(ispin), &
4353 matrix_p=almo_scf_env%matrix_p(ispin), &
4354 matrix_qp_template=almo_scf_env%matrix_t(ispin), &
4355 matrix_pq_template=almo_scf_env%matrix_t_tr(ispin), &
4356 matrix_t=almo_scf_env%matrix_t(ispin), &
4357 conjugator=almo_scf_env%deloc_cayley_conjugator, &
4358 max_iter=almo_scf_env%deloc_cayley_max_iter)
4359
4360 ! perform calculations
4361 CALL ct_step_execute(ct_step_env)
4362
4363 ! for now we do not need the new set of orbitals
4364 ! just get the energy correction
4365 CALL ct_step_env_get(ct_step_env, &
4366 energy_correction=energy_correction(ispin))
4367
4368 CALL ct_step_env_clean(ct_step_env)
4369
4370 END DO
4371
4372 energy_correction(1) = energy_correction(1)*spin_factor
4373
4374 END IF
4375
4376 ! print the energy correction and exit
4377 DO ispin = 1, nspin
4378
4379 IF (unit_nr > 0) THEN
4380 WRITE (unit_nr, *)
4381 WRITE (unit_nr, '(T2,A,I6,F20.9)') "ECORR", ispin, &
4382 energy_correction(ispin)
4383 WRITE (unit_nr, *)
4384 END IF
4385 energy_correction_final = energy_correction_final + energy_correction(ispin)
4386
4387 ! obtain density matrix from updated MOs
4388 ! RZK-later sigma and sigma_inv are lost here
4389 CALL almo_scf_t_to_proj(t=almo_scf_env%matrix_t(ispin), &
4390 p=almo_scf_env%matrix_p(ispin), &
4391 eps_filter=almo_scf_env%eps_filter, &
4392 orthog_orbs=.false., &
4393 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), &
4394 s=almo_scf_env%matrix_s(1), &
4395 sigma=almo_scf_env%matrix_sigma(ispin), &
4396 sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), &
4397 !use_guess=use_guess, &
4398 algorithm=almo_scf_env%sigma_inv_algorithm, &
4399 inverse_accelerator=almo_scf_env%order_lanczos, &
4400 inv_eps_factor=almo_scf_env%matrix_iter_eps_error_factor, &
4401 eps_lanczos=almo_scf_env%eps_lanczos, &
4402 max_iter_lanczos=almo_scf_env%max_iter_lanczos, &
4403 para_env=almo_scf_env%para_env, &
4404 blacs_env=almo_scf_env%blacs_env)
4405
4406 IF (almo_scf_env%nspins == 1) THEN
4407 CALL dbcsr_scale(almo_scf_env%matrix_p(ispin), &
4408 spin_factor)
4409 END IF
4410
4411 END DO
4412
4413 CASE (dm_ls_step)
4414
4415 ! compute the inverse of S
4416 IF (.NOT. almo_scf_env%s_inv_done) THEN
4417 IF (unit_nr > 0) THEN
4418 WRITE (unit_nr, *) "Inverting AO overlap matrix"
4419 END IF
4420 CALL dbcsr_create(almo_scf_env%matrix_s_inv(1), &
4421 template=almo_scf_env%matrix_s(1), &
4422 matrix_type=dbcsr_type_no_symmetry)
4423 IF (.NOT. almo_scf_env%s_sqrt_done) THEN
4424 CALL invert_hotelling(almo_scf_env%matrix_s_inv(1), &
4425 almo_scf_env%matrix_s(1), &
4426 threshold=almo_scf_env%eps_filter)
4427 ELSE
4428 CALL dbcsr_multiply("N", "N", 1.0_dp, almo_scf_env%matrix_s_sqrt_inv(1), &
4429 almo_scf_env%matrix_s_sqrt_inv(1), &
4430 0.0_dp, almo_scf_env%matrix_s_inv(1), &
4431 filter_eps=almo_scf_env%eps_filter)
4432 END IF
4433
4434 IF (safe_mode) THEN
4435 CALL dbcsr_create(matrix_tmp1, template=almo_scf_env%matrix_s(1), &
4436 matrix_type=dbcsr_type_no_symmetry)
4437 CALL dbcsr_multiply("N", "N", 1.0_dp, almo_scf_env%matrix_s_inv(1), &
4438 almo_scf_env%matrix_s(1), &
4439 0.0_dp, matrix_tmp1, &
4440 filter_eps=almo_scf_env%eps_filter)
4441 frob_matrix_base = dbcsr_frobenius_norm(matrix_tmp1)
4442 CALL dbcsr_add_on_diag(matrix_tmp1, -1.0_dp)
4443 frob_matrix = dbcsr_frobenius_norm(matrix_tmp1)
4444 IF (unit_nr > 0) THEN
4445 WRITE (unit_nr, *) "Error for (inv(S)*S-I)", &
4446 frob_matrix/frob_matrix_base
4447 END IF
4448 CALL dbcsr_release(matrix_tmp1)
4449 END IF
4450
4451 almo_scf_env%s_inv_done = .true.
4452
4453 END IF
4454
4455 ALLOCATE (matrix_p_almo_scf_converged(nspin))
4456 DO ispin = 1, nspin
4457 CALL dbcsr_create(matrix_p_almo_scf_converged(ispin), &
4458 template=almo_scf_env%matrix_p(ispin))
4459 CALL dbcsr_copy(matrix_p_almo_scf_converged(ispin), &
4460 almo_scf_env%matrix_p(ispin))
4461 END DO
4462
4463 ! update the density matrix
4464 DO ispin = 1, nspin
4465
4466 nelectron_spin_real(1) = almo_scf_env%nelectrons_spin(ispin)
4467 IF (almo_scf_env%nspins == 1) THEN
4468 nelectron_spin_real(1) = nelectron_spin_real(1)/2
4469 END IF
4470
4471 local_mu(1) = sum(almo_scf_env%mu_of_domain(:, ispin))/almo_scf_env%ndomains
4472 fake(1) = 123523
4473
4474 cpabort("CVS only: density_matrix_sign has not been updated in SVN")
4475
4476 IF (almo_scf_env%nspins == 1) THEN
4477 CALL dbcsr_scale(almo_scf_env%matrix_p(ispin), &
4478 spin_factor)
4479 END IF
4480 CALL dbcsr_add(matrix_p_almo_scf_converged(ispin), &
4481 almo_scf_env%matrix_p(ispin), -1.0_dp, 1.0_dp)
4482 CALL dbcsr_dot(almo_scf_env%matrix_ks_0deloc(ispin), &
4483 matrix_p_almo_scf_converged(ispin), &
4484 energy_correction(ispin))
4485
4486 energy_correction_final = energy_correction_final + energy_correction(ispin)
4487
4488 IF (unit_nr > 0) THEN
4489 WRITE (unit_nr, *)
4490 WRITE (unit_nr, '(T2,A,I6,F20.9)') "ECORR", ispin, &
4491 energy_correction(ispin)
4492 WRITE (unit_nr, *)
4493 END IF
4494
4495 END DO
4496
4497 DO ispin = 1, nspin
4498 CALL dbcsr_release(matrix_p_almo_scf_converged(ispin))
4499 END DO
4500 DEALLOCATE (matrix_p_almo_scf_converged)
4501
4502 END SELECT ! algorithm selection
4503
4504 t2 = m_walltime()
4505
4506 IF (unit_nr > 0) THEN
4507 WRITE (unit_nr, *)
4508 WRITE (unit_nr, '(T2,A,F18.9,F18.9,F18.9,F12.6)') "ETOT", &
4509 almo_scf_env%almo_scf_energy, &
4510 energy_correction_final, &
4511 almo_scf_env%almo_scf_energy + energy_correction_final, &
4512 t2 - t1
4513 WRITE (unit_nr, *)
4514 END IF
4515
4516 CALL timestop(handle)
4517
4518 END SUBROUTINE harris_foulkes_correction
4519
4520! **************************************************************************************************
4521!> \brief triu of a dbcsr matrix
4522!> \param matrix ...
4523! **************************************************************************************************
4524 SUBROUTINE make_triu(matrix)
4525 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
4526
4527 CHARACTER(len=*), PARAMETER :: routinen = 'make_triu'
4528
4529 INTEGER :: col, handle, i, j, row
4530 REAL(dp), DIMENSION(:, :), POINTER :: block
4531 TYPE(dbcsr_iterator_type) :: iter
4532
4533 CALL timeset(routinen, handle)
4534
4535 CALL dbcsr_iterator_start(iter, matrix)
4536 DO WHILE (dbcsr_iterator_blocks_left(iter))
4537 CALL dbcsr_iterator_next_block(iter, row, col, block)
4538 IF (row > col) block(:, :) = 0.0_dp
4539 IF (row == col) THEN
4540 DO j = 1, SIZE(block, 2)
4541 DO i = j + 1, SIZE(block, 1)
4542 block(i, j) = 0.0_dp
4543 END DO
4544 END DO
4545 END IF
4546 END DO
4547 CALL dbcsr_iterator_stop(iter)
4548 CALL dbcsr_filter(matrix, eps=0.0_dp)
4549
4550 CALL timestop(handle)
4551 END SUBROUTINE make_triu
4552
4553! **************************************************************************************************
4554!> \brief Computes a diagonal preconditioner for the cg optimization of k matrix
4555!> \param prec ...
4556!> \param vd_prop ...
4557!> \param f ...
4558!> \param x ...
4559!> \param oo_inv_x_tr ...
4560!> \param s ...
4561!> \param grad ...
4562!> \param vd_blk ...
4563!> \param t ...
4564!> \param template_vd_vd_blk ...
4565!> \param template_vr_vr_blk ...
4566!> \param template_n_vr ...
4567!> \param spin_factor ...
4568!> \param eps_filter ...
4569!> \par History
4570!> 2011.09 created [Rustam Z Khaliullin]
4571!> \author Rustam Z Khaliullin
4572! **************************************************************************************************
4573 SUBROUTINE opt_k_create_preconditioner(prec, vd_prop, f, x, oo_inv_x_tr, s, grad, &
4574 vd_blk, t, template_vd_vd_blk, template_vr_vr_blk, template_n_vr, &
4575 spin_factor, eps_filter)
4576
4577 TYPE(dbcsr_type), INTENT(INOUT) :: prec
4578 TYPE(dbcsr_type), INTENT(IN) :: vd_prop, f, x, oo_inv_x_tr, s
4579 TYPE(dbcsr_type), INTENT(INOUT) :: grad
4580 TYPE(dbcsr_type), INTENT(IN) :: vd_blk, t, template_vd_vd_blk, &
4581 template_vr_vr_blk, template_n_vr
4582 REAL(kind=dp), INTENT(IN) :: spin_factor, eps_filter
4583
4584 CHARACTER(len=*), PARAMETER :: routinen = 'opt_k_create_preconditioner'
4585
4586 INTEGER :: handle, p_nrows, q_nrows
4587 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: p_diagonal, q_diagonal
4588 TYPE(dbcsr_type) :: pp_diag, qq_diag, t1, t2, tmp, &
4589 tmp1_n_vr, tmp2_n_vr, tmp_n_vd, &
4590 tmp_vd_vd_blk, tmp_vr_vr_blk
4591
4592 CALL timeset(routinen, handle)
4593
4594 ! initialize a matrix to 1.0
4595 CALL dbcsr_create(tmp, template=prec)
4596 ! in order to use dbcsr_set matrix blocks must exist
4597 CALL dbcsr_copy(tmp, prec)
4598 CALL dbcsr_set(tmp, 1.0_dp)
4599
4600 ! compute qq = (Vd^tr)*F*Vd
4601 CALL dbcsr_create(tmp_n_vd, template=vd_prop)
4602 CALL dbcsr_multiply("N", "N", 1.0_dp, f, vd_prop, &
4603 0.0_dp, tmp_n_vd, filter_eps=eps_filter)
4604 CALL dbcsr_create(tmp_vd_vd_blk, &
4605 template=template_vd_vd_blk)
4606 CALL dbcsr_copy(tmp_vd_vd_blk, template_vd_vd_blk)
4607 CALL dbcsr_multiply("T", "N", 1.0_dp, vd_prop, tmp_n_vd, &
4608 0.0_dp, tmp_vd_vd_blk, &
4609 retain_sparsity=.true., &
4610 filter_eps=eps_filter)
4611 ! copy diagonal elements of the result into rows of a matrix
4612 CALL dbcsr_get_info(tmp_vd_vd_blk, nfullrows_total=q_nrows)
4613 ALLOCATE (q_diagonal(q_nrows))
4614 CALL dbcsr_get_diag(tmp_vd_vd_blk, q_diagonal)
4615 CALL dbcsr_create(qq_diag, &
4616 template=template_vd_vd_blk)
4617 CALL dbcsr_add_on_diag(qq_diag, 1.0_dp)
4618 CALL dbcsr_set_diag(qq_diag, q_diagonal)
4619 CALL dbcsr_create(t1, template=prec)
4620 CALL dbcsr_multiply("N", "N", 1.0_dp, qq_diag, tmp, &
4621 0.0_dp, t1, filter_eps=eps_filter)
4622
4623 ! compute pp = X*sigma_oo_inv*X^tr
4624 CALL dbcsr_create(tmp_vr_vr_blk, template=template_vr_vr_blk)
4625 CALL dbcsr_copy(tmp_vr_vr_blk, template_vr_vr_blk)
4626 CALL dbcsr_multiply("N", "N", 1.0_dp, x, oo_inv_x_tr, &
4627 0.0_dp, tmp_vr_vr_blk, &
4628 retain_sparsity=.true., &
4629 filter_eps=eps_filter)
4630 ! copy diagonal elements of the result into cols of a matrix
4631 CALL dbcsr_get_info(tmp_vr_vr_blk, nfullrows_total=p_nrows)
4632 ALLOCATE (p_diagonal(p_nrows))
4633 CALL dbcsr_get_diag(tmp_vr_vr_blk, p_diagonal)
4634 CALL dbcsr_create(pp_diag, template=template_vr_vr_blk)
4635 CALL dbcsr_add_on_diag(pp_diag, 1.0_dp)
4636 CALL dbcsr_set_diag(pp_diag, p_diagonal)
4637 CALL dbcsr_set(tmp, 1.0_dp)
4638 CALL dbcsr_create(t2, template=prec)
4639 CALL dbcsr_multiply("N", "N", 1.0_dp, tmp, pp_diag, &
4640 0.0_dp, t2, filter_eps=eps_filter)
4641
4642 CALL dbcsr_hadamard_product(t1, t2, prec)
4643
4644 ! compute qq = (Vd^tr)*S*Vd
4645 CALL dbcsr_multiply("N", "N", 1.0_dp, s, vd_prop, &
4646 0.0_dp, tmp_n_vd, filter_eps=eps_filter)
4647 CALL dbcsr_multiply("T", "N", 1.0_dp, vd_prop, tmp_n_vd, &
4648 0.0_dp, tmp_vd_vd_blk, &
4649 retain_sparsity=.true., &
4650 filter_eps=eps_filter)
4651 ! copy diagonal elements of the result into rows of a matrix
4652 CALL dbcsr_get_diag(tmp_vd_vd_blk, q_diagonal)
4653 CALL dbcsr_add_on_diag(qq_diag, 1.0_dp)
4654 CALL dbcsr_set_diag(qq_diag, q_diagonal)
4655 CALL dbcsr_set(tmp, 1.0_dp)
4656 CALL dbcsr_multiply("N", "N", 1.0_dp, qq_diag, tmp, &
4657 0.0_dp, t1, filter_eps=eps_filter)
4658
4659 ! compute pp = X*sig_oo_inv*(T^tr)*F*T*sig_oo_inv*(X^tr)
4660 CALL dbcsr_create(tmp1_n_vr, template=template_n_vr)
4661 CALL dbcsr_create(tmp2_n_vr, template=template_n_vr)
4662 CALL dbcsr_multiply("N", "N", 1.0_dp, t, oo_inv_x_tr, &
4663 0.0_dp, tmp1_n_vr, filter_eps=eps_filter)
4664 CALL dbcsr_multiply("N", "N", 1.0_dp, f, tmp1_n_vr, &
4665 0.0_dp, tmp2_n_vr, filter_eps=eps_filter)
4666 CALL dbcsr_multiply("T", "N", 1.0_dp, tmp1_n_vr, tmp2_n_vr, &
4667 0.0_dp, tmp_vr_vr_blk, &
4668 retain_sparsity=.true., &
4669 filter_eps=eps_filter)
4670 ! copy diagonal elements of the result into cols of a matrix
4671 CALL dbcsr_get_diag(tmp_vr_vr_blk, p_diagonal)
4672 CALL dbcsr_add_on_diag(pp_diag, 1.0_dp)
4673 CALL dbcsr_set_diag(pp_diag, p_diagonal)
4674 CALL dbcsr_set(tmp, 1.0_dp)
4675 CALL dbcsr_multiply("N", "N", 1.0_dp, tmp, pp_diag, &
4676 0.0_dp, t2, filter_eps=eps_filter)
4677
4678 CALL dbcsr_hadamard_product(t1, t2, tmp)
4679 CALL dbcsr_add(prec, tmp, 1.0_dp, -1.0_dp)
4680 CALL dbcsr_scale(prec, 2.0_dp*spin_factor)
4681
4682 ! compute qp = X*sig_oo_inv*(T^tr)*S*Vd
4683 CALL dbcsr_multiply("N", "N", 1.0_dp, s, vd_blk, &
4684 0.0_dp, tmp_n_vd, filter_eps=eps_filter)
4685 CALL dbcsr_multiply("T", "N", 1.0_dp, tmp_n_vd, tmp1_n_vr, &
4686 0.0_dp, tmp, retain_sparsity=.true., &
4687 filter_eps=eps_filter)
4688 CALL dbcsr_hadamard_product(grad, tmp, t1)
4689 ! gradient already contains 2.0*spin_factor
4690 CALL dbcsr_scale(t1, -2.0_dp)
4691
4692 CALL dbcsr_add(prec, t1, 1.0_dp, 1.0_dp)
4693
4694 CALL inverse_of_elements(prec)
4695 CALL dbcsr_filter(prec, eps_filter)
4696
4697 DEALLOCATE (q_diagonal)
4698 DEALLOCATE (p_diagonal)
4699 CALL dbcsr_release(tmp)
4700 CALL dbcsr_release(qq_diag)
4701 CALL dbcsr_release(t1)
4702 CALL dbcsr_release(pp_diag)
4703 CALL dbcsr_release(t2)
4704 CALL dbcsr_release(tmp_n_vd)
4705 CALL dbcsr_release(tmp_vd_vd_blk)
4706 CALL dbcsr_release(tmp_vr_vr_blk)
4707 CALL dbcsr_release(tmp1_n_vr)
4708 CALL dbcsr_release(tmp2_n_vr)
4709
4710 CALL timestop(handle)
4711
4712 END SUBROUTINE opt_k_create_preconditioner
4713
4714! **************************************************************************************************
4715!> \brief Computes a block-diagonal preconditioner for the optimization of
4716!> k matrix
4717!> \param almo_scf_env ...
4718!> \param vd_prop ...
4719!> \param oo_inv_x_tr ...
4720!> \param t_curr ...
4721!> \param ispin ...
4722!> \param spin_factor ...
4723!> \par History
4724!> 2011.10 created [Rustam Z Khaliullin]
4725!> \author Rustam Z Khaliullin
4726! **************************************************************************************************
4727 SUBROUTINE opt_k_create_preconditioner_blk(almo_scf_env, vd_prop, oo_inv_x_tr, &
4728 t_curr, ispin, spin_factor)
4729
4730 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
4731 TYPE(dbcsr_type), INTENT(IN) :: vd_prop, oo_inv_x_tr, t_curr
4732 INTEGER, INTENT(IN) :: ispin
4733 REAL(kind=dp), INTENT(IN) :: spin_factor
4734
4735 CHARACTER(len=*), PARAMETER :: routinen = 'opt_k_create_preconditioner_blk'
4736
4737 INTEGER :: handle
4738 REAL(kind=dp) :: eps_filter
4739 TYPE(dbcsr_type) :: opt_k_e_dd, opt_k_e_rr, s_dd_sqrt, &
4740 s_rr_sqrt, t1, tmp, tmp1_n_vr, &
4741 tmp2_n_vr, tmp_n_vd, tmp_vd_vd_blk, &
4742 tmp_vr_vr_blk
4743
4744! matrices that has been computed outside the routine already
4745
4746 CALL timeset(routinen, handle)
4747
4748 eps_filter = almo_scf_env%eps_filter
4749
4750 ! compute S_qq = (Vd^tr)*S*Vd
4751 CALL dbcsr_create(tmp_n_vd, template=almo_scf_env%matrix_v_disc(ispin))
4752 CALL dbcsr_create(tmp_vd_vd_blk, &
4753 template=almo_scf_env%matrix_vv_disc_blk(ispin), &
4754 matrix_type=dbcsr_type_no_symmetry)
4755 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4756 almo_scf_env%matrix_s(1), &
4757 vd_prop, &
4758 0.0_dp, tmp_n_vd, filter_eps=eps_filter)
4759 CALL dbcsr_copy(tmp_vd_vd_blk, &
4760 almo_scf_env%matrix_vv_disc_blk(ispin))
4761 CALL dbcsr_multiply("T", "N", 1.0_dp, vd_prop, tmp_n_vd, &
4762 0.0_dp, tmp_vd_vd_blk, &
4763 retain_sparsity=.true.)
4764
4765 CALL dbcsr_create(s_dd_sqrt, &
4766 template=almo_scf_env%matrix_vv_disc_blk(ispin), &
4767 matrix_type=dbcsr_type_no_symmetry)
4768 CALL matrix_sqrt_newton_schulz(s_dd_sqrt, &
4769 almo_scf_env%opt_k_t_dd(ispin), &
4770 tmp_vd_vd_blk, &
4771 threshold=eps_filter, &
4772 order=almo_scf_env%order_lanczos, &
4773 eps_lanczos=almo_scf_env%eps_lanczos, &
4774 max_iter_lanczos=almo_scf_env%max_iter_lanczos)
4775
4776 ! compute F_qq = (Vd^tr)*F*Vd
4777 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4778 almo_scf_env%matrix_ks_0deloc(ispin), &
4779 vd_prop, &
4780 0.0_dp, tmp_n_vd, filter_eps=eps_filter)
4781 CALL dbcsr_copy(tmp_vd_vd_blk, &
4782 almo_scf_env%matrix_vv_disc_blk(ispin))
4783 CALL dbcsr_multiply("T", "N", 1.0_dp, vd_prop, tmp_n_vd, &
4784 0.0_dp, tmp_vd_vd_blk, &
4785 retain_sparsity=.true.)
4786 CALL dbcsr_release(tmp_n_vd)
4787
4788 ! bring to the blocked-orthogonalized basis
4789 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4790 tmp_vd_vd_blk, &
4791 almo_scf_env%opt_k_t_dd(ispin), &
4792 0.0_dp, s_dd_sqrt, filter_eps=eps_filter)
4793 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4794 almo_scf_env%opt_k_t_dd(ispin), &
4795 s_dd_sqrt, &
4796 0.0_dp, tmp_vd_vd_blk, filter_eps=eps_filter)
4797
4798 ! diagonalize the matrix
4799 CALL dbcsr_create(opt_k_e_dd, &
4800 template=almo_scf_env%matrix_vv_disc_blk(ispin))
4801 CALL dbcsr_release(s_dd_sqrt)
4802 CALL dbcsr_create(s_dd_sqrt, &
4803 template=almo_scf_env%matrix_vv_disc_blk(ispin), &
4804 matrix_type=dbcsr_type_no_symmetry)
4805 CALL diagonalize_diagonal_blocks(tmp_vd_vd_blk, &
4806 s_dd_sqrt, &
4807 opt_k_e_dd)
4808
4809 ! obtain the transformation matrix in the discarded subspace
4810 ! T = S^{-1/2}.U
4811 CALL dbcsr_copy(tmp_vd_vd_blk, &
4812 almo_scf_env%opt_k_t_dd(ispin))
4813 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4814 tmp_vd_vd_blk, &
4815 s_dd_sqrt, &
4816 0.0_dp, almo_scf_env%opt_k_t_dd(ispin), &
4817 filter_eps=eps_filter)
4818 CALL dbcsr_release(s_dd_sqrt)
4819 CALL dbcsr_release(tmp_vd_vd_blk)
4820
4821 ! copy diagonal elements of the result into rows of a matrix
4822 CALL dbcsr_create(tmp, &
4823 template=almo_scf_env%matrix_k_blk_ones(ispin))
4824 CALL dbcsr_copy(tmp, &
4825 almo_scf_env%matrix_k_blk_ones(ispin))
4826 CALL dbcsr_create(t1, &
4827 template=almo_scf_env%matrix_k_blk_ones(ispin))
4828 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4829 opt_k_e_dd, tmp, &
4830 0.0_dp, t1, filter_eps=eps_filter)
4831 CALL dbcsr_release(opt_k_e_dd)
4832
4833 ! compute S_pp = X*sigma_oo_inv*X^tr
4834 CALL dbcsr_create(tmp_vr_vr_blk, &
4835 template=almo_scf_env%matrix_sigma_vv_blk(ispin), &
4836 matrix_type=dbcsr_type_no_symmetry)
4837 CALL dbcsr_copy(tmp_vr_vr_blk, &
4838 almo_scf_env%matrix_sigma_vv_blk(ispin))
4839 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4840 almo_scf_env%matrix_x(ispin), &
4841 oo_inv_x_tr, &
4842 0.0_dp, tmp_vr_vr_blk, &
4843 retain_sparsity=.true.)
4844
4845 ! obtain the orthogonalization matrix
4846 CALL dbcsr_create(s_rr_sqrt, &
4847 template=almo_scf_env%matrix_sigma_vv_blk(ispin), &
4848 matrix_type=dbcsr_type_no_symmetry)
4849 CALL matrix_sqrt_newton_schulz(s_rr_sqrt, &
4850 almo_scf_env%opt_k_t_rr(ispin), &
4851 tmp_vr_vr_blk, &
4852 threshold=eps_filter, &
4853 order=almo_scf_env%order_lanczos, &
4854 eps_lanczos=almo_scf_env%eps_lanczos, &
4855 max_iter_lanczos=almo_scf_env%max_iter_lanczos)
4856
4857 ! compute F_pp = X*sig_oo_inv*(T^tr)*F*T*sig_oo_inv*(X^tr)
4858 CALL dbcsr_create(tmp1_n_vr, &
4859 template=almo_scf_env%matrix_v(ispin))
4860 CALL dbcsr_create(tmp2_n_vr, &
4861 template=almo_scf_env%matrix_v(ispin))
4862 CALL dbcsr_multiply("N", "N", 1.0_dp, t_curr, oo_inv_x_tr, &
4863 0.0_dp, tmp1_n_vr, filter_eps=eps_filter)
4864 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4865 almo_scf_env%matrix_ks_0deloc(ispin), &
4866 tmp1_n_vr, &
4867 0.0_dp, tmp2_n_vr, filter_eps=eps_filter)
4868 CALL dbcsr_multiply("T", "N", 1.0_dp, tmp1_n_vr, tmp2_n_vr, &
4869 0.0_dp, tmp_vr_vr_blk, &
4870 retain_sparsity=.true.)
4871 CALL dbcsr_release(tmp1_n_vr)
4872 CALL dbcsr_release(tmp2_n_vr)
4873
4874 ! bring to the blocked-orthogonalized basis
4875 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4876 tmp_vr_vr_blk, &
4877 almo_scf_env%opt_k_t_rr(ispin), &
4878 0.0_dp, s_rr_sqrt, filter_eps=eps_filter)
4879 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4880 almo_scf_env%opt_k_t_rr(ispin), &
4881 s_rr_sqrt, &
4882 0.0_dp, tmp_vr_vr_blk, filter_eps=eps_filter)
4883
4884 ! diagonalize the matrix
4885 CALL dbcsr_create(opt_k_e_rr, &
4886 template=almo_scf_env%matrix_sigma_vv_blk(ispin))
4887 CALL dbcsr_release(s_rr_sqrt)
4888 CALL dbcsr_create(s_rr_sqrt, &
4889 template=almo_scf_env%matrix_sigma_vv_blk(ispin), &
4890 matrix_type=dbcsr_type_no_symmetry)
4891 CALL diagonalize_diagonal_blocks(tmp_vr_vr_blk, &
4892 s_rr_sqrt, &
4893 opt_k_e_rr)
4894
4895 ! obtain the transformation matrix in the retained subspace
4896 ! T = S^{-1/2}.U
4897 CALL dbcsr_copy(tmp_vr_vr_blk, &
4898 almo_scf_env%opt_k_t_rr(ispin))
4899 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4900 tmp_vr_vr_blk, &
4901 s_rr_sqrt, &
4902 0.0_dp, almo_scf_env%opt_k_t_rr(ispin), &
4903 filter_eps=eps_filter)
4904 CALL dbcsr_release(s_rr_sqrt)
4905 CALL dbcsr_release(tmp_vr_vr_blk)
4906
4907 ! copy diagonal elements of the result into cols of a matrix
4908 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4909 tmp, opt_k_e_rr, &
4910 0.0_dp, almo_scf_env%opt_k_denom(ispin), &
4911 filter_eps=eps_filter)
4912 CALL dbcsr_release(opt_k_e_rr)
4913 CALL dbcsr_release(tmp)
4914
4915 ! form the denominator matrix
4916 CALL dbcsr_add(almo_scf_env%opt_k_denom(ispin), t1, &
4917 -1.0_dp, 1.0_dp)
4918 CALL dbcsr_release(t1)
4919 CALL dbcsr_scale(almo_scf_env%opt_k_denom(ispin), &
4920 2.0_dp*spin_factor)
4921
4922 CALL inverse_of_elements(almo_scf_env%opt_k_denom(ispin))
4923 CALL dbcsr_filter(almo_scf_env%opt_k_denom(ispin), &
4924 eps_filter)
4925
4926 CALL timestop(handle)
4927
4928 END SUBROUTINE opt_k_create_preconditioner_blk
4929
4930! **************************************************************************************************
4931!> \brief Applies a block-diagonal preconditioner for the optimization of
4932!> k matrix (preconditioner matrices must be calculated and stored
4933!> beforehand)
4934!> \param almo_scf_env ...
4935!> \param step ...
4936!> \param grad ...
4937!> \param ispin ...
4938!> \par History
4939!> 2011.10 created [Rustam Z Khaliullin]
4940!> \author Rustam Z Khaliullin
4941! **************************************************************************************************
4942 SUBROUTINE opt_k_apply_preconditioner_blk(almo_scf_env, step, grad, ispin)
4943
4944 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
4945 TYPE(dbcsr_type), INTENT(OUT) :: step
4946 TYPE(dbcsr_type), INTENT(IN) :: grad
4947 INTEGER, INTENT(IN) :: ispin
4948
4949 CHARACTER(len=*), PARAMETER :: routinen = 'opt_k_apply_preconditioner_blk'
4950
4951 INTEGER :: handle
4952 REAL(kind=dp) :: eps_filter
4953 TYPE(dbcsr_type) :: tmp_k
4954
4955 CALL timeset(routinen, handle)
4956
4957 eps_filter = almo_scf_env%eps_filter
4958
4959 CALL dbcsr_create(tmp_k, template=almo_scf_env%matrix_k_blk(ispin))
4960
4961 ! transform gradient to the correct "diagonal" basis
4962 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4963 grad, almo_scf_env%opt_k_t_rr(ispin), &
4964 0.0_dp, tmp_k, filter_eps=eps_filter)
4965 CALL dbcsr_multiply("T", "N", 1.0_dp, &
4966 almo_scf_env%opt_k_t_dd(ispin), tmp_k, &
4967 0.0_dp, step, filter_eps=eps_filter)
4968
4969 ! apply diagonal preconditioner
4970 CALL dbcsr_hadamard_product(step, &
4971 almo_scf_env%opt_k_denom(ispin), tmp_k)
4972
4973 ! back-transform the result to the initial basis
4974 CALL dbcsr_multiply("N", "N", 1.0_dp, &
4975 almo_scf_env%opt_k_t_dd(ispin), tmp_k, &
4976 0.0_dp, step, filter_eps=eps_filter)
4977 CALL dbcsr_multiply("N", "T", 1.0_dp, &
4978 step, almo_scf_env%opt_k_t_rr(ispin), &
4979 0.0_dp, tmp_k, filter_eps=eps_filter)
4980
4981 CALL dbcsr_copy(step, tmp_k)
4982
4983 CALL dbcsr_release(tmp_k)
4984
4985 CALL timestop(handle)
4986
4987 END SUBROUTINE opt_k_apply_preconditioner_blk
4988
4989! **************************************************************************************************
4990!> \brief Compute the gradient wrt the main variable (e.g. Theta, X)
4991!> \param m_grad_out ...
4992!> \param m_ks ...
4993!> \param m_s ...
4994!> \param m_t ...
4995!> \param m_t0 ...
4996!> \param m_siginv ...
4997!> \param m_quench_t ...
4998!> \param m_FTsiginv ...
4999!> \param m_siginvTFTsiginv ...
5000!> \param m_ST ...
5001!> \param m_STsiginv0 ...
5002!> \param m_theta ...
5003!> \param domain_s_inv ...
5004!> \param domain_r_down ...
5005!> \param cpu_of_domain ...
5006!> \param domain_map ...
5007!> \param assume_t0_q0x ...
5008!> \param optimize_theta ...
5009!> \param normalize_orbitals ...
5010!> \param penalty_occ_vol ...
5011!> \param penalty_occ_local ...
5012!> \param penalty_occ_vol_prefactor ...
5013!> \param envelope_amplitude ...
5014!> \param eps_filter ...
5015!> \param spin_factor ...
5016!> \param special_case ...
5017!> \param m_sig_sqrti_ii ...
5018!> \param op_sm_set ...
5019!> \param weights ...
5020!> \param energy_coeff ...
5021!> \param localiz_coeff ...
5022!> \par History
5023!> 2015.03 created [Rustam Z Khaliullin]
5024!> \author Rustam Z Khaliullin
5025! **************************************************************************************************
5026 SUBROUTINE compute_gradient(m_grad_out, m_ks, m_s, m_t, m_t0, &
5027 m_siginv, m_quench_t, m_FTsiginv, m_siginvTFTsiginv, m_ST, m_STsiginv0, &
5028 m_theta, domain_s_inv, domain_r_down, &
5029 cpu_of_domain, domain_map, assume_t0_q0x, optimize_theta, &
5030 normalize_orbitals, penalty_occ_vol, penalty_occ_local, &
5031 penalty_occ_vol_prefactor, envelope_amplitude, eps_filter, spin_factor, &
5032 special_case, m_sig_sqrti_ii, op_sm_set, weights, energy_coeff, &
5033 localiz_coeff)
5034
5035 TYPE(dbcsr_type), INTENT(INOUT) :: m_grad_out, m_ks, m_s, m_t, m_t0, &
5036 m_siginv, m_quench_t, m_ftsiginv, &
5037 m_siginvtftsiginv, m_st, m_stsiginv0, &
5038 m_theta
5039 TYPE(domain_submatrix_type), DIMENSION(:), &
5040 INTENT(IN) :: domain_s_inv, domain_r_down
5041 INTEGER, DIMENSION(:), INTENT(IN) :: cpu_of_domain
5042 TYPE(domain_map_type), INTENT(IN) :: domain_map
5043 LOGICAL, INTENT(IN) :: assume_t0_q0x, optimize_theta, &
5044 normalize_orbitals, penalty_occ_vol
5045 LOGICAL, INTENT(IN), OPTIONAL :: penalty_occ_local
5046 REAL(kind=dp), INTENT(IN) :: penalty_occ_vol_prefactor, &
5047 envelope_amplitude, eps_filter, &
5048 spin_factor
5049 INTEGER, INTENT(IN) :: special_case
5050 TYPE(dbcsr_type), INTENT(IN), OPTIONAL :: m_sig_sqrti_ii
5051 TYPE(dbcsr_p_type), DIMENSION(:, :), OPTIONAL, &
5052 POINTER :: op_sm_set
5053 REAL(kind=dp), DIMENSION(:), INTENT(IN), OPTIONAL :: weights
5054 REAL(kind=dp), INTENT(IN), OPTIONAL :: energy_coeff, localiz_coeff
5055
5056 CHARACTER(len=*), PARAMETER :: routinen = 'compute_gradient'
5057
5058 INTEGER :: dim0, handle, idim0, nao, reim
5059 LOGICAL :: my_penalty_local
5060 REAL(kind=dp) :: coeff, energy_g_norm, my_energy_coeff, &
5061 my_localiz_coeff, &
5062 penalty_occ_vol_g_norm
5063 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: tg_diagonal
5064 TYPE(dbcsr_type) :: m_tmp_no_1, m_tmp_no_2, m_tmp_no_3, &
5065 m_tmp_oo_1, m_tmp_oo_2, temp1, temp2, &
5066 tempnocc1, tempoccocc1
5067
5068 CALL timeset(routinen, handle)
5069
5070 IF (normalize_orbitals .AND. (.NOT. PRESENT(m_sig_sqrti_ii))) THEN
5071 cpabort("Normalization matrix is required")
5072 END IF
5073
5074 my_penalty_local = .false.
5075 my_localiz_coeff = 1.0_dp
5076 my_energy_coeff = 0.0_dp
5077 IF (PRESENT(localiz_coeff)) THEN
5078 my_localiz_coeff = localiz_coeff
5079 END IF
5080 IF (PRESENT(energy_coeff)) THEN
5081 my_energy_coeff = energy_coeff
5082 END IF
5083 IF (PRESENT(penalty_occ_local)) THEN
5084 my_penalty_local = penalty_occ_local
5085 END IF
5086
5087 ! use this otherways unused variables
5088 CALL dbcsr_get_info(matrix=m_ks, nfullrows_total=nao)
5089 CALL dbcsr_get_info(matrix=m_s, nfullrows_total=nao)
5090 CALL dbcsr_get_info(matrix=m_t, nfullrows_total=nao)
5091
5092 CALL dbcsr_create(m_tmp_no_1, &
5093 template=m_quench_t, &
5094 matrix_type=dbcsr_type_no_symmetry)
5095 CALL dbcsr_create(m_tmp_no_2, &
5096 template=m_quench_t, &
5097 matrix_type=dbcsr_type_no_symmetry)
5098 CALL dbcsr_create(m_tmp_no_3, &
5099 template=m_quench_t, &
5100 matrix_type=dbcsr_type_no_symmetry)
5101 CALL dbcsr_create(m_tmp_oo_1, &
5102 template=m_siginv, &
5103 matrix_type=dbcsr_type_no_symmetry)
5104 CALL dbcsr_create(m_tmp_oo_2, &
5105 template=m_siginv, &
5106 matrix_type=dbcsr_type_no_symmetry)
5107 CALL dbcsr_create(tempnocc1, &
5108 template=m_t, &
5109 matrix_type=dbcsr_type_no_symmetry)
5110 CALL dbcsr_create(tempoccocc1, &
5111 template=m_siginv, &
5112 matrix_type=dbcsr_type_no_symmetry)
5113 CALL dbcsr_create(temp1, &
5114 template=m_t, &
5115 matrix_type=dbcsr_type_no_symmetry)
5116 CALL dbcsr_create(temp2, &
5117 template=m_t, &
5118 matrix_type=dbcsr_type_no_symmetry)
5119
5120 CALL dbcsr_copy(m_tmp_no_2, m_quench_t)
5121 CALL dbcsr_copy(m_tmp_no_2, m_ftsiginv, keep_sparsity=.true.)
5122
5123 CALL dbcsr_multiply("N", "N", -1.0_dp, &
5124 m_st, &
5125 m_siginvtftsiginv, &
5126 1.0_dp, m_tmp_no_2, &
5127 retain_sparsity=.true.)
5128 CALL dbcsr_scale(m_tmp_no_2, 2.0_dp*spin_factor)
5129
5130 ! LzL Add gradient for Localization
5131 IF (my_penalty_local) THEN
5132
5133 CALL dbcsr_set(temp2, 0.0_dp) ! accumulate the localization gradient here
5134
5135 DO idim0 = 1, SIZE(op_sm_set, 2) ! this loop is over miller ind
5136
5137 DO reim = 1, SIZE(op_sm_set, 1) ! this loop is over Re/Im
5138
5139 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5140 op_sm_set(reim, idim0)%matrix, &
5141 m_t, &
5142 0.0_dp, tempnocc1, &
5143 filter_eps=eps_filter)
5144
5145 ! warning - save time by computing only the diagonal elements
5146 CALL dbcsr_multiply("T", "N", 1.0_dp, &
5147 m_t, &
5148 tempnocc1, &
5149 0.0_dp, tempoccocc1, &
5150 filter_eps=eps_filter)
5151
5152 CALL dbcsr_get_info(tempoccocc1, nfullrows_total=dim0)
5153 ALLOCATE (tg_diagonal(dim0))
5154 CALL dbcsr_get_diag(tempoccocc1, tg_diagonal)
5155 CALL dbcsr_set(tempoccocc1, 0.0_dp)
5156 CALL dbcsr_set_diag(tempoccocc1, tg_diagonal)
5157 DEALLOCATE (tg_diagonal)
5158
5159 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5160 tempnocc1, &
5161 tempoccocc1, &
5162 0.0_dp, temp1, &
5163 filter_eps=eps_filter)
5164
5165 END DO
5166
5167 SELECT CASE (2) ! allows for selection of different spread functionals
5168 CASE (1) ! functional = -W_I * log( |z_I|^2 )
5169 cpabort("Localization function is not implemented")
5170 CASE (2) ! functional = W_I * ( 1 - |z_I|^2 )
5171 coeff = -weights(idim0)
5172 CASE (3) ! functional = W_I * ( 1 - |z_I| )
5173 cpabort("Localization function is not implemented")
5174 END SELECT
5175 CALL dbcsr_add(temp2, temp1, 1.0_dp, coeff)
5176
5177 END DO ! end loop over idim0
5178 CALL dbcsr_add(m_tmp_no_2, temp2, my_energy_coeff, my_localiz_coeff*4.0_dp)
5179 END IF
5180
5181 ! add penalty on the occupied volume: det(sigma)
5182 IF (penalty_occ_vol) THEN
5183 CALL dbcsr_copy(m_tmp_no_1, m_quench_t)
5184 CALL dbcsr_multiply("N", "N", &
5185 penalty_occ_vol_prefactor, &
5186 m_st, &
5187 m_siginv, &
5188 0.0_dp, m_tmp_no_1, &
5189 retain_sparsity=.true.)
5190 ! this norm does not contain the normalization factors
5191 penalty_occ_vol_g_norm = dbcsr_maxabs(m_tmp_no_1)
5192 energy_g_norm = dbcsr_maxabs(m_tmp_no_2)
5193 CALL dbcsr_add(m_tmp_no_2, m_tmp_no_1, 1.0_dp, 1.0_dp)
5194 END IF
5195
5196 ! take into account the factor from the normalization constraint
5197 IF (normalize_orbitals) THEN
5198
5199 ! G = ( G - ST.[tr(T).G]_ii ) . [sig_sqrti]_ii
5200 ! this expression can be simplified to
5201 ! G = ( G - c0*ST ) . [sig_sqrti]_ii
5202 ! where c0 = penalty_occ_vol_prefactor
5203 ! This is because tr(T).G_Energy = 0 and
5204 ! tr(T).G_Penalty = c0*I
5205
5206 ! slower way of taking the norm into account
5207 CALL dbcsr_copy(m_tmp_no_1, m_quench_t)
5208 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5209 m_tmp_no_2, &
5210 m_sig_sqrti_ii, &
5211 0.0_dp, m_tmp_no_1, &
5212 retain_sparsity=.true.)
5213
5214 ! get [tr(T).G]_ii
5215 CALL dbcsr_copy(m_tmp_oo_1, m_sig_sqrti_ii)
5216 CALL dbcsr_multiply("T", "N", 1.0_dp, &
5217 m_t, &
5218 m_tmp_no_2, &
5219 0.0_dp, m_tmp_oo_1, &
5220 retain_sparsity=.true.)
5221
5222 CALL dbcsr_get_info(m_sig_sqrti_ii, nfullrows_total=dim0)
5223 ALLOCATE (tg_diagonal(dim0))
5224 CALL dbcsr_get_diag(m_tmp_oo_1, tg_diagonal)
5225 CALL dbcsr_set(m_tmp_oo_1, 0.0_dp)
5226 CALL dbcsr_set_diag(m_tmp_oo_1, tg_diagonal)
5227 DEALLOCATE (tg_diagonal)
5228
5229 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5230 m_sig_sqrti_ii, &
5231 m_tmp_oo_1, &
5232 0.0_dp, m_tmp_oo_2, &
5233 filter_eps=eps_filter)
5234 CALL dbcsr_multiply("N", "N", -1.0_dp, &
5235 m_st, &
5236 m_tmp_oo_2, &
5237 1.0_dp, m_tmp_no_1, &
5238 retain_sparsity=.true.)
5239
5240 ELSE
5241
5242 CALL dbcsr_copy(m_tmp_no_1, m_tmp_no_2)
5243
5244 END IF ! normalize_orbitals
5245
5246 ! project out the occupied space from the gradient
5247 IF (assume_t0_q0x) THEN
5248 IF (special_case == xalmo_case_fully_deloc) THEN
5249 CALL dbcsr_copy(m_grad_out, m_tmp_no_1)
5250 CALL dbcsr_multiply("T", "N", 1.0_dp, &
5251 m_t0, &
5252 m_grad_out, &
5253 0.0_dp, m_tmp_oo_1, &
5254 filter_eps=eps_filter)
5255 CALL dbcsr_multiply("N", "N", -1.0_dp, &
5256 m_stsiginv0, &
5257 m_tmp_oo_1, &
5258 1.0_dp, m_grad_out, &
5259 filter_eps=eps_filter)
5260 ELSE IF (special_case == xalmo_case_block_diag) THEN
5261 cpabort("Cannot project the zero-order space from itself")
5262 ELSE
5263 ! no special case: normal xALMOs
5264 CALL apply_domain_operators( &
5265 matrix_in=m_tmp_no_1, &
5266 matrix_out=m_grad_out, &
5267 operator2=domain_r_down(:), &
5268 operator1=domain_s_inv(:), &
5269 dpattern=m_quench_t, &
5270 map=domain_map, &
5271 node_of_domain=cpu_of_domain, &
5272 my_action=1, &
5273 filter_eps=eps_filter, &
5274 !matrix_trimmer=,&
5275 use_trimmer=.false.)
5276 END IF ! my_special_case
5277 CALL dbcsr_copy(m_tmp_no_1, m_grad_out)
5278 END IF
5279
5280 ! transform d_E/d_T to d_E/d_theta
5281 IF (optimize_theta) THEN
5282 CALL dbcsr_copy(m_tmp_no_2, m_theta)
5283 CALL dtanh_of_elements(m_tmp_no_2, alpha=1.0_dp/envelope_amplitude)
5284 CALL dbcsr_scale(m_tmp_no_2, envelope_amplitude)
5285 CALL dbcsr_set(m_tmp_no_3, 0.0_dp)
5286 CALL dbcsr_filter(m_tmp_no_3, eps_filter)
5287 CALL dbcsr_hadamard_product(m_tmp_no_1, &
5288 m_tmp_no_2, &
5289 m_tmp_no_3)
5290 CALL dbcsr_hadamard_product(m_tmp_no_3, &
5291 m_quench_t, &
5292 m_grad_out)
5293 ELSE ! simply copy
5294 CALL dbcsr_hadamard_product(m_tmp_no_1, &
5295 m_quench_t, &
5296 m_grad_out)
5297 END IF
5298 CALL dbcsr_filter(m_grad_out, eps_filter)
5299
5300 CALL dbcsr_release(m_tmp_no_1)
5301 CALL dbcsr_release(m_tmp_no_2)
5302 CALL dbcsr_release(m_tmp_no_3)
5303 CALL dbcsr_release(m_tmp_oo_1)
5304 CALL dbcsr_release(m_tmp_oo_2)
5305 CALL dbcsr_release(tempnocc1)
5306 CALL dbcsr_release(tempoccocc1)
5307 CALL dbcsr_release(temp1)
5308 CALL dbcsr_release(temp2)
5309
5310 CALL timestop(handle)
5311
5312 END SUBROUTINE compute_gradient
5313
5314! **************************************************************************************************
5315!> \brief Serial code that prints matrices readable by Mathematica
5316!> \param matrix - matrix to print
5317!> \param filename ...
5318!> \par History
5319!> 2015.05 created [Rustam Z. Khaliullin]
5320!> \author Rustam Z. Khaliullin
5321! **************************************************************************************************
5322 SUBROUTINE print_mathematica_matrix(matrix, filename)
5323
5324 TYPE(dbcsr_type), INTENT(IN) :: matrix
5325 CHARACTER(len=*), INTENT(IN) :: filename
5326
5327 CHARACTER(len=*), PARAMETER :: routinen = 'print_mathematica_matrix'
5328
5329 CHARACTER(LEN=20) :: formatstr, scols
5330 INTEGER :: col, fiunit, handle, hori_offset, jj, &
5331 nblkcols_tot, nblkrows_tot, ncols, &
5332 ncores, nrows, row, unit_nr, &
5333 vert_offset
5334 INTEGER, ALLOCATABLE, DIMENSION(:) :: ao_block_sizes, mo_block_sizes
5335 INTEGER, DIMENSION(:), POINTER :: ao_blk_sizes, mo_blk_sizes
5336 LOGICAL :: found
5337 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: h
5338 REAL(kind=dp), DIMENSION(:, :), POINTER :: block_p
5339 TYPE(cp_logger_type), POINTER :: logger
5340 TYPE(dbcsr_distribution_type) :: dist
5341 TYPE(dbcsr_type) :: matrix_asym
5342
5343 CALL timeset(routinen, handle)
5344
5345 ! get a useful output_unit
5346 logger => cp_get_default_logger()
5347 IF (logger%para_env%is_source()) THEN
5348 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
5349 ELSE
5350 unit_nr = -1
5351 END IF
5352
5353 ! serial code only
5354 CALL dbcsr_get_info(matrix, distribution=dist)
5355 CALL dbcsr_distribution_get(dist, numnodes=ncores)
5356 IF (ncores > 1) THEN
5357 cpabort("mathematica files: serial code only")
5358 END IF
5359
5360 CALL dbcsr_get_info(matrix, row_blk_size=ao_blk_sizes, col_blk_size=mo_blk_sizes, &
5361 nblkrows_total=nblkrows_tot, nblkcols_total=nblkcols_tot)
5362 cpassert(nblkrows_tot == nblkcols_tot)
5363 ALLOCATE (mo_block_sizes(nblkcols_tot), ao_block_sizes(nblkcols_tot))
5364 mo_block_sizes(:) = mo_blk_sizes(:)
5365 ao_block_sizes(:) = ao_blk_sizes(:)
5366
5367 CALL dbcsr_create(matrix_asym, &
5368 template=matrix, &
5369 matrix_type=dbcsr_type_no_symmetry)
5370 CALL dbcsr_desymmetrize(matrix, matrix_asym)
5371
5372 ncols = sum(mo_block_sizes)
5373 nrows = sum(ao_block_sizes)
5374 ALLOCATE (h(nrows, ncols))
5375 h(:, :) = 0.0_dp
5376
5377 hori_offset = 0
5378 DO col = 1, nblkcols_tot
5379
5380 vert_offset = 0
5381 DO row = 1, nblkrows_tot
5382
5383 CALL dbcsr_get_block_p(matrix_asym, row, col, block_p, found)
5384 IF (found) THEN
5385
5386 h(vert_offset + 1:vert_offset + ao_block_sizes(row), &
5387 hori_offset + 1:hori_offset + mo_block_sizes(col)) &
5388 = block_p(:, :)
5389
5390 END IF
5391
5392 vert_offset = vert_offset + ao_block_sizes(row)
5393
5394 END DO
5395
5396 hori_offset = hori_offset + mo_block_sizes(col)
5397
5398 END DO ! loop over electron blocks
5399
5400 CALL dbcsr_release(matrix_asym)
5401
5402 IF (unit_nr > 0) THEN
5403 CALL open_file(filename, unit_number=fiunit, file_status='REPLACE')
5404 WRITE (scols, "(I10)") ncols
5405 formatstr = "("//trim(scols)//"E27.17)"
5406 DO jj = 1, nrows
5407 WRITE (fiunit, formatstr) h(jj, :)
5408 END DO
5409 CALL close_file(fiunit)
5410 END IF
5411
5412 DEALLOCATE (mo_block_sizes)
5413 DEALLOCATE (ao_block_sizes)
5414 DEALLOCATE (h)
5415
5416 CALL timestop(handle)
5417
5418 END SUBROUTINE print_mathematica_matrix
5419
5420! **************************************************************************************************
5421!> \brief Compute the objective functional of NLMOs
5422!> \param localization_obj_function_ispin ...
5423!> \param penalty_func_ispin ...
5424!> \param penalty_vol_prefactor ...
5425!> \param overlap_determinant ...
5426!> \param m_sigma ...
5427!> \param nocc ...
5428!> \param m_B0 ...
5429!> \param m_theta_normalized ...
5430!> \param template_matrix_mo ...
5431!> \param weights ...
5432!> \param m_S0 ...
5433!> \param just_started ...
5434!> \param penalty_amplitude ...
5435!> \param eps_filter ...
5436!> \par History
5437!> 2020.01 created [Ziling Luo]
5438!> \author Ziling Luo
5439! **************************************************************************************************
5440 SUBROUTINE compute_obj_nlmos(localization_obj_function_ispin, penalty_func_ispin, &
5441 penalty_vol_prefactor, overlap_determinant, m_sigma, nocc, m_B0, &
5442 m_theta_normalized, template_matrix_mo, weights, m_S0, just_started, &
5443 penalty_amplitude, eps_filter)
5444
5445 REAL(kind=dp), INTENT(INOUT) :: localization_obj_function_ispin, penalty_func_ispin, &
5446 penalty_vol_prefactor, overlap_determinant
5447 TYPE(dbcsr_type), INTENT(INOUT) :: m_sigma
5448 INTEGER, INTENT(IN) :: nocc
5449 TYPE(dbcsr_type), DIMENSION(:, :), INTENT(IN) :: m_b0
5450 TYPE(dbcsr_type), INTENT(IN) :: m_theta_normalized, template_matrix_mo
5451 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: weights
5452 TYPE(dbcsr_type), INTENT(IN) :: m_s0
5453 LOGICAL, INTENT(IN) :: just_started
5454 REAL(kind=dp), INTENT(IN) :: penalty_amplitude, eps_filter
5455
5456 CHARACTER(len=*), PARAMETER :: routinen = 'compute_obj_nlmos'
5457
5458 INTEGER :: handle, idim0, ielem, reim
5459 REAL(kind=dp) :: det1, fval
5460 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: reim_diag, z2
5461 TYPE(dbcsr_type) :: tempnocc1, tempoccocc1, tempoccocc2
5462 TYPE(mp_comm_type) :: group
5463
5464 CALL timeset(routinen, handle)
5465
5466 CALL dbcsr_create(tempnocc1, &
5467 template=template_matrix_mo, &
5468 matrix_type=dbcsr_type_no_symmetry)
5469 CALL dbcsr_create(tempoccocc1, &
5470 template=m_theta_normalized, &
5471 matrix_type=dbcsr_type_no_symmetry)
5472 CALL dbcsr_create(tempoccocc2, &
5473 template=m_theta_normalized, &
5474 matrix_type=dbcsr_type_no_symmetry)
5475
5476 localization_obj_function_ispin = 0.0_dp
5477 penalty_func_ispin = 0.0_dp
5478 ALLOCATE (z2(nocc))
5479 ALLOCATE (reim_diag(nocc))
5480
5481 CALL dbcsr_get_info(tempoccocc2, group=group)
5482
5483 DO idim0 = 1, SIZE(m_b0, 2) ! this loop is over miller ind
5484
5485 z2(:) = 0.0_dp
5486
5487 DO reim = 1, SIZE(m_b0, 1) ! this loop is over Re/Im
5488
5489 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5490 m_b0(reim, idim0), &
5491 m_theta_normalized, &
5492 0.0_dp, tempoccocc1, &
5493 filter_eps=eps_filter)
5494 CALL dbcsr_set(tempoccocc2, 0.0_dp)
5495 CALL dbcsr_add_on_diag(tempoccocc2, 1.0_dp)
5496 CALL dbcsr_multiply("T", "N", 1.0_dp, &
5497 m_theta_normalized, &
5498 tempoccocc1, &
5499 0.0_dp, tempoccocc2, &
5500 retain_sparsity=.true.)
5501
5502 reim_diag = 0.0_dp
5503 CALL dbcsr_get_diag(tempoccocc2, reim_diag)
5504 CALL group%sum(reim_diag)
5505 z2(:) = z2(:) + reim_diag(:)*reim_diag(:)
5506
5507 END DO
5508
5509 DO ielem = 1, nocc
5510 SELECT CASE (2) ! allows for selection of different spread functionals
5511 CASE (1) ! functional = -W_I * log( |z_I|^2 )
5512 fval = -weights(idim0)*log(abs(z2(ielem)))
5513 CASE (2) ! functional = W_I * ( 1 - |z_I|^2 )
5514 fval = weights(idim0) - weights(idim0)*abs(z2(ielem))
5515 CASE (3) ! functional = W_I * ( 1 - |z_I| )
5516 fval = weights(idim0) - weights(idim0)*sqrt(abs(z2(ielem)))
5517 END SELECT
5518 localization_obj_function_ispin = localization_obj_function_ispin + fval
5519 END DO
5520
5521 END DO ! end loop over idim0
5522
5523 DEALLOCATE (z2)
5524 DEALLOCATE (reim_diag)
5525
5526 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5527 m_s0, &
5528 m_theta_normalized, &
5529 0.0_dp, tempoccocc1, &
5530 filter_eps=eps_filter)
5531 ! compute current sigma
5532 CALL dbcsr_multiply("T", "N", 1.0_dp, &
5533 m_theta_normalized, &
5534 tempoccocc1, &
5535 0.0_dp, m_sigma, &
5536 filter_eps=eps_filter)
5537
5538 CALL determinant(m_sigma, det1, &
5539 eps_filter)
5540 ! save the current determinant
5541 overlap_determinant = det1
5542
5543 IF (just_started .AND. penalty_amplitude < 0.0_dp) THEN
5544 penalty_vol_prefactor = -(-penalty_amplitude)*localization_obj_function_ispin
5545 END IF
5546 penalty_func_ispin = penalty_func_ispin + penalty_vol_prefactor*log(det1)
5547
5548 CALL dbcsr_release(tempnocc1)
5549 CALL dbcsr_release(tempoccocc1)
5550 CALL dbcsr_release(tempoccocc2)
5551
5552 CALL timestop(handle)
5553
5554 END SUBROUTINE compute_obj_nlmos
5555
5556! **************************************************************************************************
5557!> \brief Compute the gradient wrt the main variable
5558!> \param m_grad_out ...
5559!> \param m_B0 ...
5560!> \param weights ...
5561!> \param m_S0 ...
5562!> \param m_theta_normalized ...
5563!> \param m_siginv ...
5564!> \param m_sig_sqrti_ii ...
5565!> \param penalty_vol_prefactor ...
5566!> \param eps_filter ...
5567!> \param suggested_vol_penalty ...
5568!> \par History
5569!> 2018.10 created [Ziling Luo]
5570!> \author Ziling Luo
5571! **************************************************************************************************
5572 SUBROUTINE compute_gradient_nlmos(m_grad_out, m_B0, weights, &
5573 m_S0, m_theta_normalized, m_siginv, m_sig_sqrti_ii, &
5574 penalty_vol_prefactor, eps_filter, suggested_vol_penalty)
5575
5576 TYPE(dbcsr_type), INTENT(INOUT) :: m_grad_out
5577 TYPE(dbcsr_type), DIMENSION(:, :), INTENT(IN) :: m_b0
5578 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: weights
5579 TYPE(dbcsr_type), INTENT(IN) :: m_s0, m_theta_normalized, m_siginv, &
5580 m_sig_sqrti_ii
5581 REAL(kind=dp), INTENT(IN) :: penalty_vol_prefactor, eps_filter
5582 REAL(kind=dp), INTENT(INOUT) :: suggested_vol_penalty
5583
5584 CHARACTER(len=*), PARAMETER :: routinen = 'compute_gradient_nlmos'
5585
5586 INTEGER :: dim0, handle, idim0, reim
5587 REAL(kind=dp) :: norm_loc, norm_vol
5588 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: tg_diagonal, z2
5589 TYPE(dbcsr_type) :: m_temp_oo_1, m_temp_oo_2, m_temp_oo_3, &
5590 m_temp_oo_4
5591
5592 CALL timeset(routinen, handle)
5593
5594 CALL dbcsr_create(m_temp_oo_1, &
5595 template=m_theta_normalized, &
5596 matrix_type=dbcsr_type_no_symmetry)
5597 CALL dbcsr_create(m_temp_oo_2, &
5598 template=m_theta_normalized, &
5599 matrix_type=dbcsr_type_no_symmetry)
5600 CALL dbcsr_create(m_temp_oo_3, &
5601 template=m_theta_normalized, &
5602 matrix_type=dbcsr_type_no_symmetry)
5603 CALL dbcsr_create(m_temp_oo_4, &
5604 template=m_theta_normalized, &
5605 matrix_type=dbcsr_type_no_symmetry)
5606
5607 CALL dbcsr_get_info(m_siginv, nfullrows_total=dim0)
5608 ALLOCATE (tg_diagonal(dim0))
5609 ALLOCATE (z2(dim0))
5610 CALL dbcsr_set(m_temp_oo_1, 0.0_dp) ! accumulate the gradient wrt a_norm here
5611
5612 ! do d_Omega/d_a_normalized first
5613 DO idim0 = 1, SIZE(m_b0, 2) ! this loop is over miller ind
5614
5615 z2(:) = 0.0_dp
5616 CALL dbcsr_set(m_temp_oo_2, 0.0_dp) ! accumulate index gradient here
5617 DO reim = 1, SIZE(m_b0, 1) ! this loop is over Re/Im
5618
5619 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5620 m_b0(reim, idim0), &
5621 m_theta_normalized, &
5622 0.0_dp, m_temp_oo_3, &
5623 filter_eps=eps_filter)
5624
5625 ! result contain Re/Im part of Z for the current Miller index
5626 ! warning - save time by computing only the diagonal elements
5627 CALL dbcsr_multiply("T", "N", 1.0_dp, &
5628 m_theta_normalized, &
5629 m_temp_oo_3, &
5630 0.0_dp, m_temp_oo_4, &
5631 filter_eps=eps_filter)
5632
5633 tg_diagonal(:) = 0.0_dp
5634 CALL dbcsr_get_diag(m_temp_oo_4, tg_diagonal)
5635 CALL dbcsr_set(m_temp_oo_4, 0.0_dp)
5636 CALL dbcsr_set_diag(m_temp_oo_4, tg_diagonal)
5637 z2(:) = z2(:) + tg_diagonal(:)*tg_diagonal(:)
5638
5639 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5640 m_temp_oo_3, &
5641 m_temp_oo_4, &
5642 1.0_dp, m_temp_oo_2, &
5643 filter_eps=eps_filter)
5644
5645 END DO
5646
5647 ! TODO: because some elements are zeros on some MPI tasks the
5648 ! gradient evaluation will fail for CASE 1 and 3
5649 SELECT CASE (2) ! allows for selection of different spread functionals
5650 CASE (1) ! functional = -W_I * log( |z_I|^2 )
5651 z2(:) = -weights(idim0)/z2(:)
5652 CASE (2) ! functional = W_I * ( 1 - |z_I|^2 )
5653 z2(:) = -weights(idim0)
5654 CASE (3) ! functional = W_I * ( 1 - |z_I| )
5655 z2(:) = -weights(idim0)/(2*sqrt(z2(:)))
5656 END SELECT
5657 CALL dbcsr_set(m_temp_oo_3, 0.0_dp)
5658 CALL dbcsr_set_diag(m_temp_oo_3, z2)
5659 ! TODO: print this matrix to make sure its block structure is fine
5660 ! and there are no unecessary elements
5661
5662 CALL dbcsr_multiply("N", "N", 4.0_dp, &
5663 m_temp_oo_2, &
5664 m_temp_oo_3, &
5665 1.0_dp, m_temp_oo_1, &
5666 filter_eps=eps_filter)
5667
5668 END DO ! end loop over idim0
5669 DEALLOCATE (z2)
5670
5671 ! sigma0.a_norm is necessary for the volume penalty and normalization
5672 CALL dbcsr_multiply("N", "N", &
5673 1.0_dp, &
5674 m_s0, &
5675 m_theta_normalized, &
5676 0.0_dp, m_temp_oo_2, &
5677 filter_eps=eps_filter)
5678
5679 ! add gradient of the penalty functional log[det(sigma)]
5680 ! G = 2*prefactor*sigma0.a_norm.sigma_inv
5681 CALL dbcsr_multiply("N", "N", &
5682 1.0_dp, &
5683 m_temp_oo_2, &
5684 m_siginv, &
5685 0.0_dp, m_temp_oo_3, &
5686 filter_eps=eps_filter)
5687 norm_vol = dbcsr_maxabs(m_temp_oo_3)
5688 norm_loc = dbcsr_maxabs(m_temp_oo_1)
5689 suggested_vol_penalty = norm_loc/norm_vol
5690 CALL dbcsr_add(m_temp_oo_1, m_temp_oo_3, &
5691 1.0_dp, 2.0_dp*penalty_vol_prefactor)
5692
5693 ! take into account the factor from the normalization constraint
5694 ! G = ( G - sigma0.a_norm.[tr(a_norm).G]_ii ) . [sig_sqrti]_ii
5695 ! 1. get G.[sig_sqrti]_ii
5696 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5697 m_temp_oo_1, &
5698 m_sig_sqrti_ii, &
5699 0.0_dp, m_grad_out, &
5700 filter_eps=eps_filter)
5701
5702 ! 2. get [tr(a_norm).G]_ii
5703 ! it is possible to save time by computing only the diagonal elements
5704 CALL dbcsr_multiply("T", "N", 1.0_dp, &
5705 m_theta_normalized, &
5706 m_temp_oo_1, &
5707 0.0_dp, m_temp_oo_3, &
5708 filter_eps=eps_filter)
5709 CALL dbcsr_get_diag(m_temp_oo_3, tg_diagonal)
5710 CALL dbcsr_set(m_temp_oo_3, 0.0_dp)
5711 CALL dbcsr_set_diag(m_temp_oo_3, tg_diagonal)
5712
5713 ! 3. [X]_ii . [sig_sqrti]_ii
5714 ! it is possible to save time by computing only the diagonal elements
5715 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5716 m_sig_sqrti_ii, &
5717 m_temp_oo_3, &
5718 0.0_dp, m_temp_oo_1, &
5719 filter_eps=eps_filter)
5720 ! 4. (sigma0*a_norm) .[X]_ii
5721 CALL dbcsr_multiply("N", "N", -1.0_dp, &
5722 m_temp_oo_2, &
5723 m_temp_oo_1, &
5724 1.0_dp, m_grad_out, &
5725 filter_eps=eps_filter)
5726
5727 DEALLOCATE (tg_diagonal)
5728 CALL dbcsr_release(m_temp_oo_1)
5729 CALL dbcsr_release(m_temp_oo_2)
5730 CALL dbcsr_release(m_temp_oo_3)
5731 CALL dbcsr_release(m_temp_oo_4)
5732
5733 CALL timestop(handle)
5734
5735 END SUBROUTINE compute_gradient_nlmos
5736
5737! **************************************************************************************************
5738!> \brief Compute MO coeffs from the main optimized variable (e.g. Theta, X)
5739!> \param m_var_in ...
5740!> \param m_t_out ...
5741!> \param m_quench_t ...
5742!> \param m_t0 ...
5743!> \param m_oo_template ...
5744!> \param m_STsiginv0 ...
5745!> \param m_s ...
5746!> \param m_sig_sqrti_ii_out ...
5747!> \param domain_r_down ...
5748!> \param domain_s_inv ...
5749!> \param domain_map ...
5750!> \param cpu_of_domain ...
5751!> \param assume_t0_q0x ...
5752!> \param just_started ...
5753!> \param optimize_theta ...
5754!> \param normalize_orbitals ...
5755!> \param envelope_amplitude ...
5756!> \param eps_filter ...
5757!> \param special_case ...
5758!> \param nocc_of_domain ...
5759!> \param order_lanczos ...
5760!> \param eps_lanczos ...
5761!> \param max_iter_lanczos ...
5762!> \par History
5763!> 2015.03 created [Rustam Z Khaliullin]
5764!> \author Rustam Z Khaliullin
5765! **************************************************************************************************
5766 SUBROUTINE compute_xalmos_from_main_var(m_var_in, m_t_out, m_quench_t, &
5767 m_t0, m_oo_template, m_STsiginv0, m_s, m_sig_sqrti_ii_out, domain_r_down, &
5768 domain_s_inv, domain_map, cpu_of_domain, assume_t0_q0x, just_started, &
5769 optimize_theta, normalize_orbitals, envelope_amplitude, eps_filter, &
5770 special_case, nocc_of_domain, order_lanczos, eps_lanczos, max_iter_lanczos)
5771
5772 TYPE(dbcsr_type), INTENT(IN) :: m_var_in
5773 TYPE(dbcsr_type), INTENT(INOUT) :: m_t_out, m_quench_t, m_t0, &
5774 m_oo_template, m_stsiginv0, m_s, &
5775 m_sig_sqrti_ii_out
5776 TYPE(domain_submatrix_type), DIMENSION(:), &
5777 INTENT(IN) :: domain_r_down, domain_s_inv
5778 TYPE(domain_map_type), INTENT(IN) :: domain_map
5779 INTEGER, DIMENSION(:), INTENT(IN) :: cpu_of_domain
5780 LOGICAL, INTENT(IN) :: assume_t0_q0x, just_started, &
5781 optimize_theta, normalize_orbitals
5782 REAL(kind=dp), INTENT(IN) :: envelope_amplitude, eps_filter
5783 INTEGER, INTENT(IN) :: special_case
5784 INTEGER, DIMENSION(:), INTENT(IN) :: nocc_of_domain
5785 INTEGER, INTENT(IN) :: order_lanczos
5786 REAL(kind=dp), INTENT(IN) :: eps_lanczos
5787 INTEGER, INTENT(IN) :: max_iter_lanczos
5788
5789 CHARACTER(len=*), PARAMETER :: routinen = 'compute_xalmos_from_main_var'
5790
5791 INTEGER :: handle, unit_nr
5792 REAL(kind=dp) :: t_norm
5793 TYPE(cp_logger_type), POINTER :: logger
5794 TYPE(dbcsr_type) :: m_tmp_no_1, m_tmp_oo_1
5795
5796 CALL timeset(routinen, handle)
5797
5798 ! get a useful output_unit
5799 logger => cp_get_default_logger()
5800 IF (logger%para_env%is_source()) THEN
5801 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
5802 ELSE
5803 unit_nr = -1
5804 END IF
5805
5806 CALL dbcsr_create(m_tmp_no_1, &
5807 template=m_quench_t, &
5808 matrix_type=dbcsr_type_no_symmetry)
5809 CALL dbcsr_create(m_tmp_oo_1, &
5810 template=m_oo_template, &
5811 matrix_type=dbcsr_type_no_symmetry)
5812
5813 CALL dbcsr_copy(m_tmp_no_1, m_var_in)
5814 IF (optimize_theta) THEN
5815 ! check that all MO coefficients of the guess are less
5816 ! than the maximum allowed amplitude
5817 t_norm = dbcsr_maxabs(m_tmp_no_1)
5818 IF (unit_nr > 0) THEN
5819 WRITE (unit_nr, *) "Maximum norm of the initial guess: ", t_norm
5820 WRITE (unit_nr, *) "Maximum allowed amplitude: ", &
5821 envelope_amplitude
5822 END IF
5823 IF (t_norm > envelope_amplitude .AND. just_started) THEN
5824 cpabort("Max norm of the initial guess is too large")
5825 END IF
5826 ! use artanh to tame MOs
5827 CALL tanh_of_elements(m_tmp_no_1, alpha=1.0_dp/envelope_amplitude)
5828 CALL dbcsr_scale(m_tmp_no_1, envelope_amplitude)
5829 END IF
5830 CALL dbcsr_hadamard_product(m_tmp_no_1, m_quench_t, &
5831 m_t_out)
5832
5833 ! project out R_0
5834 IF (assume_t0_q0x) THEN
5835 IF (special_case == xalmo_case_fully_deloc) THEN
5836 CALL dbcsr_multiply("T", "N", 1.0_dp, &
5837 m_stsiginv0, &
5838 m_t_out, &
5839 0.0_dp, m_tmp_oo_1, &
5840 filter_eps=eps_filter)
5841 CALL dbcsr_multiply("N", "N", -1.0_dp, &
5842 m_t0, &
5843 m_tmp_oo_1, &
5844 1.0_dp, m_t_out, &
5845 filter_eps=eps_filter)
5846 ELSE IF (special_case == xalmo_case_block_diag) THEN
5847 cpabort("cannot use projector with block-daigonal ALMOs")
5848 ELSE
5849 ! no special case
5850 CALL apply_domain_operators( &
5851 matrix_in=m_t_out, &
5852 matrix_out=m_tmp_no_1, &
5853 operator1=domain_r_down, &
5854 operator2=domain_s_inv, &
5855 dpattern=m_quench_t, &
5856 map=domain_map, &
5857 node_of_domain=cpu_of_domain, &
5858 my_action=1, &
5859 filter_eps=eps_filter, &
5860 use_trimmer=.false.)
5861 CALL dbcsr_copy(m_t_out, &
5862 m_tmp_no_1)
5863 END IF ! special case
5864 CALL dbcsr_add(m_t_out, &
5865 m_t0, 1.0_dp, 1.0_dp)
5866 END IF
5867
5868 IF (normalize_orbitals) THEN
5869 CALL orthogonalize_mos( &
5870 ket=m_t_out, &
5871 overlap=m_tmp_oo_1, &
5872 metric=m_s, &
5873 retain_locality=.true., &
5874 only_normalize=.true., &
5875 nocc_of_domain=nocc_of_domain(:), &
5876 eps_filter=eps_filter, &
5877 order_lanczos=order_lanczos, &
5878 eps_lanczos=eps_lanczos, &
5879 max_iter_lanczos=max_iter_lanczos, &
5880 overlap_sqrti=m_sig_sqrti_ii_out)
5881 END IF
5882
5883 CALL dbcsr_filter(m_t_out, eps_filter)
5884
5885 CALL dbcsr_release(m_tmp_no_1)
5886 CALL dbcsr_release(m_tmp_oo_1)
5887
5888 CALL timestop(handle)
5889
5890 END SUBROUTINE compute_xalmos_from_main_var
5891
5892! **************************************************************************************************
5893!> \brief Compute the preconditioner matrices and invert them if necessary
5894!> \param domain_prec_out ...
5895!> \param m_prec_out ...
5896!> \param m_ks ...
5897!> \param m_s ...
5898!> \param m_siginv ...
5899!> \param m_quench_t ...
5900!> \param m_FTsiginv ...
5901!> \param m_siginvTFTsiginv ...
5902!> \param m_ST ...
5903!> \param m_STsiginv_out ...
5904!> \param m_s_vv_out ...
5905!> \param m_f_vv_out ...
5906!> \param para_env ...
5907!> \param blacs_env ...
5908!> \param nocc_of_domain ...
5909!> \param domain_s_inv ...
5910!> \param domain_s_inv_half ...
5911!> \param domain_s_half ...
5912!> \param domain_r_down ...
5913!> \param cpu_of_domain ...
5914!> \param domain_map ...
5915!> \param assume_t0_q0x ...
5916!> \param penalty_occ_vol ...
5917!> \param penalty_occ_vol_prefactor ...
5918!> \param eps_filter ...
5919!> \param neg_thr ...
5920!> \param spin_factor ...
5921!> \param special_case ...
5922!> \param bad_modes_projector_down_out ...
5923!> \param skip_inversion ...
5924!> \par History
5925!> 2015.03 created [Rustam Z Khaliullin]
5926!> \author Rustam Z Khaliullin
5927! **************************************************************************************************
5928 SUBROUTINE compute_preconditioner(domain_prec_out, m_prec_out, m_ks, m_s, &
5929 m_siginv, m_quench_t, m_FTsiginv, m_siginvTFTsiginv, m_ST, &
5930 m_STsiginv_out, m_s_vv_out, m_f_vv_out, para_env, &
5931 blacs_env, nocc_of_domain, domain_s_inv, domain_s_inv_half, domain_s_half, &
5932 domain_r_down, cpu_of_domain, &
5933 domain_map, assume_t0_q0x, penalty_occ_vol, penalty_occ_vol_prefactor, &
5934 eps_filter, neg_thr, spin_factor, special_case, bad_modes_projector_down_out, &
5935 skip_inversion)
5936
5937 TYPE(domain_submatrix_type), DIMENSION(:), &
5938 INTENT(INOUT) :: domain_prec_out
5939 TYPE(dbcsr_type), INTENT(INOUT) :: m_prec_out, m_ks, m_s
5940 TYPE(dbcsr_type), INTENT(IN) :: m_siginv, m_quench_t, m_ftsiginv, &
5941 m_siginvtftsiginv, m_st
5942 TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL :: m_stsiginv_out, m_s_vv_out, m_f_vv_out
5943 TYPE(mp_para_env_type), POINTER :: para_env
5944 TYPE(cp_blacs_env_type), POINTER :: blacs_env
5945 INTEGER, DIMENSION(:), INTENT(IN) :: nocc_of_domain
5946 TYPE(domain_submatrix_type), DIMENSION(:), &
5947 INTENT(IN) :: domain_s_inv
5948 TYPE(domain_submatrix_type), DIMENSION(:), &
5949 INTENT(IN), OPTIONAL :: domain_s_inv_half, domain_s_half
5950 TYPE(domain_submatrix_type), DIMENSION(:), &
5951 INTENT(IN) :: domain_r_down
5952 INTEGER, DIMENSION(:), INTENT(IN) :: cpu_of_domain
5953 TYPE(domain_map_type), INTENT(IN) :: domain_map
5954 LOGICAL, INTENT(IN) :: assume_t0_q0x, penalty_occ_vol
5955 REAL(kind=dp), INTENT(IN) :: penalty_occ_vol_prefactor, eps_filter, &
5956 neg_thr, spin_factor
5957 INTEGER, INTENT(IN) :: special_case
5958 TYPE(domain_submatrix_type), DIMENSION(:), &
5959 INTENT(INOUT), OPTIONAL :: bad_modes_projector_down_out
5960 LOGICAL, INTENT(IN) :: skip_inversion
5961
5962 CHARACTER(len=*), PARAMETER :: routinen = 'compute_preconditioner'
5963
5964 INTEGER :: handle, ndim, precond_domain_projector
5965 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: nn_diagonal
5966 TYPE(dbcsr_type) :: m_tmp_nn_1, m_tmp_no_3
5967
5968 CALL timeset(routinen, handle)
5969
5970 CALL dbcsr_create(m_tmp_nn_1, &
5971 template=m_s, &
5972 matrix_type=dbcsr_type_no_symmetry)
5973 CALL dbcsr_create(m_tmp_no_3, &
5974 template=m_quench_t, &
5975 matrix_type=dbcsr_type_no_symmetry)
5976
5977 ! calculate (1-R)F(1-R) and S-SRS
5978 ! RZK-warning take advantage: some elements will be removed by the quencher
5979 ! RZK-warning S operations can be performed outside the spin loop to save time
5980 ! IT IS REQUIRED THAT PRECONDITIONER DOES NOT BREAK THE LOCALITY!!!!
5981 ! RZK-warning: further optimization is ABSOLUTELY NECESSARY
5982
5983 ! First S-SRS
5984 CALL dbcsr_multiply("N", "N", 1.0_dp, &
5985 m_st, &
5986 m_siginv, &
5987 0.0_dp, m_tmp_no_3, &
5988 filter_eps=eps_filter)
5989 CALL dbcsr_desymmetrize(m_s, m_tmp_nn_1)
5990 ! return STsiginv if necessary
5991 IF (PRESENT(m_stsiginv_out)) THEN
5992 CALL dbcsr_copy(m_stsiginv_out, m_tmp_no_3)
5993 END IF
5994 IF (special_case == xalmo_case_fully_deloc) THEN
5995 ! use S instead of S-SRS
5996 ELSE
5997 CALL dbcsr_multiply("N", "T", -1.0_dp, &
5998 m_st, &
5999 m_tmp_no_3, &
6000 1.0_dp, m_tmp_nn_1, &
6001 filter_eps=eps_filter)
6002 END IF
6003 ! return S_vv = (S or S-SRS) if necessary
6004 IF (PRESENT(m_s_vv_out)) THEN
6005 CALL dbcsr_copy(m_s_vv_out, m_tmp_nn_1)
6006 END IF
6007
6008 ! Second (1-R)F(1-R)
6009 ! re-create matrix because desymmetrize is buggy -
6010 ! it will create multiple copies of blocks
6011 CALL dbcsr_desymmetrize(m_ks, m_prec_out)
6012 CALL dbcsr_multiply("N", "T", -1.0_dp, &
6013 m_ftsiginv, &
6014 m_st, &
6015 1.0_dp, m_prec_out, &
6016 filter_eps=eps_filter)
6017 CALL dbcsr_multiply("N", "T", -1.0_dp, &
6018 m_st, &
6019 m_ftsiginv, &
6020 1.0_dp, m_prec_out, &
6021 filter_eps=eps_filter)
6022 CALL dbcsr_multiply("N", "N", 1.0_dp, &
6023 m_st, &
6024 m_siginvtftsiginv, &
6025 0.0_dp, m_tmp_no_3, &
6026 filter_eps=eps_filter)
6027 CALL dbcsr_multiply("N", "T", 1.0_dp, &
6028 m_tmp_no_3, &
6029 m_st, &
6030 1.0_dp, m_prec_out, &
6031 filter_eps=eps_filter)
6032 ! return F_vv = (I-SR)F(I-RS) if necessary
6033 IF (PRESENT(m_f_vv_out)) THEN
6034 CALL dbcsr_copy(m_f_vv_out, m_prec_out)
6035 END IF
6036
6037 ! sum up the F_vv and S_vv terms
6038 CALL dbcsr_add(m_prec_out, m_tmp_nn_1, &
6039 1.0_dp, 1.0_dp)
6040 ! Scale to obtain unit step length
6041 CALL dbcsr_scale(m_prec_out, 2.0_dp*spin_factor)
6042
6043 ! add the contribution from the penalty on the occupied volume
6044 IF (penalty_occ_vol) THEN
6045 CALL dbcsr_add(m_prec_out, m_tmp_nn_1, &
6046 1.0_dp, penalty_occ_vol_prefactor)
6047 END IF
6048
6049 CALL dbcsr_copy(m_tmp_nn_1, m_prec_out)
6050
6051 ! invert using various algorithms
6052 IF (special_case == xalmo_case_block_diag) THEN ! non-overlapping diagonal blocks
6053
6054 IF (skip_inversion) THEN
6055
6056 ! impose block-diagonal structure
6057 CALL dbcsr_get_info(m_s, nfullrows_total=ndim)
6058 ALLOCATE (nn_diagonal(ndim))
6059 CALL dbcsr_get_diag(m_s, nn_diagonal)
6060 CALL dbcsr_set(m_prec_out, 0.0_dp)
6061 CALL dbcsr_set_diag(m_prec_out, nn_diagonal)
6062 CALL dbcsr_filter(m_prec_out, eps_filter)
6063 DEALLOCATE (nn_diagonal)
6064
6065 CALL dbcsr_copy(m_prec_out, m_tmp_nn_1, keep_sparsity=.true.)
6066
6067 ELSE
6068
6069 CALL pseudo_invert_diagonal_blk( &
6070 matrix_in=m_tmp_nn_1, &
6071 matrix_out=m_prec_out, &
6072 nocc=nocc_of_domain(:) &
6073 )
6074
6075 END IF
6076
6077 ELSE IF (special_case == xalmo_case_fully_deloc) THEN ! the entire system is a block
6078
6079 IF (skip_inversion) THEN
6080 CALL dbcsr_copy(m_prec_out, m_tmp_nn_1)
6081 ELSE
6082
6083 ! invert using cholesky (works with S matrix, will not work with S-SRS matrix)
6084 CALL cp_dbcsr_cholesky_decompose(m_prec_out, &
6085 para_env=para_env, &
6086 blacs_env=blacs_env)
6087 CALL cp_dbcsr_cholesky_invert(m_prec_out, &
6088 para_env=para_env, &
6089 blacs_env=blacs_env, &
6090 uplo_to_full=.true.)
6091 END IF !skip_inversion
6092
6093 CALL dbcsr_filter(m_prec_out, eps_filter)
6094
6095 ELSE
6096
6097 !!! use a true domain preconditioner with overlapping domains
6098 IF (assume_t0_q0x) THEN
6099 precond_domain_projector = -1
6100 ELSE
6101 precond_domain_projector = 0
6102 END IF
6103 !! RZK-warning: use PRESENT to make two nearly-identical calls
6104 !! this is done because intel compiler does not seem to conform
6105 !! to the FORTRAN standard for passing through optional arguments
6106 IF (PRESENT(bad_modes_projector_down_out)) THEN
6107 CALL construct_domain_preconditioner( &
6108 matrix_main=m_tmp_nn_1, &
6109 subm_s_inv=domain_s_inv(:), &
6110 subm_s_inv_half=domain_s_inv_half(:), &
6111 subm_s_half=domain_s_half(:), &
6112 subm_r_down=domain_r_down(:), &
6113 matrix_trimmer=m_quench_t, &
6114 dpattern=m_quench_t, &
6115 map=domain_map, &
6116 node_of_domain=cpu_of_domain, &
6117 preconditioner=domain_prec_out(:), &
6118 use_trimmer=.false., &
6119 bad_modes_projector_down=bad_modes_projector_down_out(:), &
6120 eps_zero_eigenvalues=neg_thr, &
6121 my_action=precond_domain_projector, &
6122 skip_inversion=skip_inversion &
6123 )
6124 ELSE
6125 CALL construct_domain_preconditioner( &
6126 matrix_main=m_tmp_nn_1, &
6127 subm_s_inv=domain_s_inv(:), &
6128 subm_r_down=domain_r_down(:), &
6129 matrix_trimmer=m_quench_t, &
6130 dpattern=m_quench_t, &
6131 map=domain_map, &
6132 node_of_domain=cpu_of_domain, &
6133 preconditioner=domain_prec_out(:), &
6134 use_trimmer=.false., &
6135 !eps_zero_eigenvalues=neg_thr,&
6136 my_action=precond_domain_projector, &
6137 skip_inversion=skip_inversion &
6138 )
6139 END IF
6140
6141 END IF ! special_case
6142
6143 CALL dbcsr_release(m_tmp_nn_1)
6144 CALL dbcsr_release(m_tmp_no_3)
6145
6146 CALL timestop(handle)
6147
6148 END SUBROUTINE compute_preconditioner
6149
6150! **************************************************************************************************
6151!> \brief Compute beta for conjugate gradient algorithms
6152!> \param beta ...
6153!> \param numer ...
6154!> \param denom ...
6155!> \param reset_conjugator ...
6156!> \param conjugator ...
6157!> \param grad ...
6158!> \param prev_grad ...
6159!> \param step ...
6160!> \param prev_step ...
6161!> \param prev_minus_prec_grad ...
6162!> \par History
6163!> 2015.04 created [Rustam Z Khaliullin]
6164!> \author Rustam Z Khaliullin
6165! **************************************************************************************************
6166 SUBROUTINE compute_cg_beta(beta, numer, denom, reset_conjugator, conjugator, &
6167 grad, prev_grad, step, prev_step, prev_minus_prec_grad)
6168
6169 REAL(kind=dp), INTENT(INOUT) :: beta
6170 REAL(kind=dp), INTENT(INOUT), OPTIONAL :: numer, denom
6171 LOGICAL, INTENT(INOUT) :: reset_conjugator
6172 INTEGER, INTENT(IN) :: conjugator
6173 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: grad, prev_grad, step, prev_step
6174 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT), &
6175 OPTIONAL :: prev_minus_prec_grad
6176
6177 CHARACTER(len=*), PARAMETER :: routinen = 'compute_cg_beta'
6178
6179 INTEGER :: handle, i, nsize, unit_nr
6180 REAL(kind=dp) :: den, kappa, my_denom, my_numer, &
6181 my_numer2, my_numer3, num, num2, num3, &
6182 tau
6183 TYPE(cp_logger_type), POINTER :: logger
6184 TYPE(dbcsr_type) :: m_tmp_no_1
6185
6186 CALL timeset(routinen, handle)
6187
6188 ! get a useful output_unit
6189 logger => cp_get_default_logger()
6190 IF (logger%para_env%is_source()) THEN
6191 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
6192 ELSE
6193 unit_nr = -1
6194 END IF
6195
6196 IF (.NOT. PRESENT(prev_minus_prec_grad)) THEN
6197 IF (conjugator == cg_fletcher_reeves .OR. &
6198 conjugator == cg_polak_ribiere .OR. &
6199 conjugator == cg_hager_zhang) THEN
6200 cpabort("conjugator needs more input")
6201 END IF
6202 END IF
6203
6204 ! return num denom so beta can be calculated spin-by-spin
6205 IF (PRESENT(numer) .OR. PRESENT(denom)) THEN
6206 IF (conjugator == cg_hestenes_stiefel .OR. &
6207 conjugator == cg_dai_yuan .OR. &
6208 conjugator == cg_hager_zhang) THEN
6209 cpabort("cannot return numer/denom")
6210 END IF
6211 END IF
6212
6213 nsize = SIZE(grad)
6214
6215 my_numer = 0.0_dp
6216 my_numer2 = 0.0_dp
6217 my_numer3 = 0.0_dp
6218 my_denom = 0.0_dp
6219
6220 DO i = 1, nsize
6221
6222 CALL dbcsr_create(m_tmp_no_1, &
6223 template=grad(i), &
6224 matrix_type=dbcsr_type_no_symmetry)
6225
6226 SELECT CASE (conjugator)
6227 CASE (cg_hestenes_stiefel)
6228 CALL dbcsr_copy(m_tmp_no_1, grad(i))
6229 CALL dbcsr_add(m_tmp_no_1, prev_grad(i), &
6230 1.0_dp, -1.0_dp)
6231 CALL dbcsr_dot(m_tmp_no_1, step(i), num)
6232 CALL dbcsr_dot(m_tmp_no_1, prev_step(i), den)
6233 CASE (cg_fletcher_reeves)
6234 CALL dbcsr_dot(grad(i), step(i), num)
6235 CALL dbcsr_dot(prev_grad(i), prev_minus_prec_grad(i), den)
6236 CASE (cg_polak_ribiere)
6237 CALL dbcsr_dot(prev_grad(i), prev_minus_prec_grad(i), den)
6238 CALL dbcsr_copy(m_tmp_no_1, grad(i))
6239 CALL dbcsr_add(m_tmp_no_1, prev_grad(i), 1.0_dp, -1.0_dp)
6240 CALL dbcsr_dot(m_tmp_no_1, step(i), num)
6241 CASE (cg_fletcher)
6242 CALL dbcsr_dot(grad(i), step(i), num)
6243 CALL dbcsr_dot(prev_grad(i), prev_step(i), den)
6244 CASE (cg_liu_storey)
6245 CALL dbcsr_dot(prev_grad(i), prev_step(i), den)
6246 CALL dbcsr_copy(m_tmp_no_1, grad(i))
6247 CALL dbcsr_add(m_tmp_no_1, prev_grad(i), 1.0_dp, -1.0_dp)
6248 CALL dbcsr_dot(m_tmp_no_1, step(i), num)
6249 CASE (cg_dai_yuan)
6250 CALL dbcsr_dot(grad(i), step(i), num)
6251 CALL dbcsr_copy(m_tmp_no_1, grad(i))
6252 CALL dbcsr_add(m_tmp_no_1, prev_grad(i), 1.0_dp, -1.0_dp)
6253 CALL dbcsr_dot(m_tmp_no_1, prev_step(i), den)
6254 CASE (cg_hager_zhang)
6255 CALL dbcsr_copy(m_tmp_no_1, grad(i))
6256 CALL dbcsr_add(m_tmp_no_1, prev_grad(i), 1.0_dp, -1.0_dp)
6257 CALL dbcsr_dot(m_tmp_no_1, prev_step(i), den)
6258 CALL dbcsr_dot(m_tmp_no_1, prev_minus_prec_grad(i), num)
6259 CALL dbcsr_dot(m_tmp_no_1, step(i), num2)
6260 CALL dbcsr_dot(prev_step(i), grad(i), num3)
6261 my_numer2 = my_numer2 + num2
6262 my_numer3 = my_numer3 + num3
6263 CASE (cg_zero)
6264 num = 0.0_dp
6265 den = 1.0_dp
6266 CASE DEFAULT
6267 cpabort("illegal conjugator")
6268 END SELECT
6269 my_numer = my_numer + num
6270 my_denom = my_denom + den
6271
6272 CALL dbcsr_release(m_tmp_no_1)
6273
6274 END DO ! i - nsize
6275
6276 DO i = 1, nsize
6277
6278 SELECT CASE (conjugator)
6279 CASE (cg_hestenes_stiefel, cg_dai_yuan)
6280 beta = -1.0_dp*my_numer/my_denom
6281 CASE (cg_fletcher_reeves, cg_polak_ribiere, cg_fletcher, cg_liu_storey)
6282 beta = my_numer/my_denom
6283 CASE (cg_hager_zhang)
6284 kappa = -2.0_dp*my_numer/my_denom
6285 tau = -1.0_dp*my_numer2/my_denom
6286 beta = tau - kappa*my_numer3/my_denom
6287 CASE (cg_zero)
6288 beta = 0.0_dp
6289 CASE DEFAULT
6290 cpabort("illegal conjugator")
6291 END SELECT
6292
6293 END DO ! i - nsize
6294
6295 IF (beta < 0.0_dp) THEN
6296 IF (unit_nr > 0) THEN
6297 WRITE (unit_nr, *) " Resetting conjugator because beta is negative: ", beta
6298 END IF
6299 reset_conjugator = .true.
6300 END IF
6301
6302 IF (PRESENT(numer)) THEN
6303 numer = my_numer
6304 END IF
6305 IF (PRESENT(denom)) THEN
6306 denom = my_denom
6307 END IF
6308
6309 CALL timestop(handle)
6310
6311 END SUBROUTINE compute_cg_beta
6312
6313! **************************************************************************************************
6314!> \brief computes the step matrix from the gradient and Hessian using the Newton-Raphson method
6315!> \param optimizer ...
6316!> \param m_grad ...
6317!> \param m_delta ...
6318!> \param m_s ...
6319!> \param m_ks ...
6320!> \param m_siginv ...
6321!> \param m_quench_t ...
6322!> \param m_FTsiginv ...
6323!> \param m_siginvTFTsiginv ...
6324!> \param m_ST ...
6325!> \param m_t ...
6326!> \param m_sig_sqrti_ii ...
6327!> \param domain_s_inv ...
6328!> \param domain_r_down ...
6329!> \param domain_map ...
6330!> \param cpu_of_domain ...
6331!> \param nocc_of_domain ...
6332!> \param para_env ...
6333!> \param blacs_env ...
6334!> \param eps_filter ...
6335!> \param optimize_theta ...
6336!> \param penalty_occ_vol ...
6337!> \param normalize_orbitals ...
6338!> \param penalty_occ_vol_prefactor ...
6339!> \param penalty_occ_vol_pf2 ...
6340!> \param special_case ...
6341!> \par History
6342!> 2015.04 created [Rustam Z. Khaliullin]
6343!> \author Rustam Z. Khaliullin
6344! **************************************************************************************************
6345 SUBROUTINE newton_grad_to_step(optimizer, m_grad, m_delta, m_s, m_ks, &
6346 m_siginv, m_quench_t, m_FTsiginv, m_siginvTFTsiginv, m_ST, m_t, &
6347 m_sig_sqrti_ii, domain_s_inv, domain_r_down, domain_map, cpu_of_domain, &
6348 nocc_of_domain, para_env, blacs_env, eps_filter, optimize_theta, &
6349 penalty_occ_vol, normalize_orbitals, penalty_occ_vol_prefactor, &
6350 penalty_occ_vol_pf2, special_case)
6351
6352 TYPE(optimizer_options_type), INTENT(IN) :: optimizer
6353 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_grad
6354 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_delta, m_s, m_ks, m_siginv, m_quench_t
6355 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_ftsiginv, m_siginvtftsiginv, m_st, &
6356 m_t, m_sig_sqrti_ii
6357 TYPE(domain_submatrix_type), DIMENSION(:, :), &
6358 INTENT(IN) :: domain_s_inv, domain_r_down
6359 TYPE(domain_map_type), DIMENSION(:), INTENT(IN) :: domain_map
6360 INTEGER, DIMENSION(:), INTENT(IN) :: cpu_of_domain
6361 INTEGER, DIMENSION(:, :), INTENT(IN) :: nocc_of_domain
6362 TYPE(mp_para_env_type), POINTER :: para_env
6363 TYPE(cp_blacs_env_type), POINTER :: blacs_env
6364 REAL(kind=dp), INTENT(IN) :: eps_filter
6365 LOGICAL, INTENT(IN) :: optimize_theta, penalty_occ_vol, &
6366 normalize_orbitals
6367 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: penalty_occ_vol_prefactor, &
6368 penalty_occ_vol_pf2
6369 INTEGER, INTENT(IN) :: special_case
6370
6371 CHARACTER(len=*), PARAMETER :: routinen = 'newton_grad_to_step'
6372
6373 CHARACTER(LEN=20) :: iter_type
6374 INTEGER :: handle, ispin, iteration, max_iter, &
6375 ndomains, nspins, outer_iteration, &
6376 outer_max_iter, unit_nr
6377 LOGICAL :: converged, do_exact_inversion, outer_prepare_to_exit, prepare_to_exit, &
6378 reset_conjugator, use_preconditioner
6379 REAL(kind=dp) :: alpha, beta, denom, denom_ispin, &
6380 eps_error_target, numer, numer_ispin, &
6381 residue_norm, spin_factor, t1, t2
6382 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: residue_max_norm
6383 TYPE(cp_logger_type), POINTER :: logger
6384 TYPE(dbcsr_type) :: m_tmp_oo_1, m_tmp_oo_2
6385 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: m_f_vo, m_f_vv, m_hstep, m_prec, &
6386 m_residue, m_residue_prev, m_s_vv, &
6387 m_step, m_stsiginv, m_zet, m_zet_prev
6388 TYPE(domain_submatrix_type), ALLOCATABLE, &
6389 DIMENSION(:, :) :: domain_prec
6390
6391 CALL timeset(routinen, handle)
6392
6393 ! get a useful output_unit
6394 logger => cp_get_default_logger()
6395 IF (logger%para_env%is_source()) THEN
6396 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
6397 ELSE
6398 unit_nr = -1
6399 END IF
6400
6401 !!! Currently for non-theta only
6402 IF (optimize_theta) THEN
6403 cpabort("theta is NYI")
6404 END IF
6405
6406 ! set optimizer options
6407 use_preconditioner = (optimizer%preconditioner /= xalmo_prec_zero)
6408 outer_max_iter = optimizer%max_iter_outer_loop
6409 max_iter = optimizer%max_iter
6410 eps_error_target = optimizer%eps_error
6411
6412 ! set key dimensions
6413 nspins = SIZE(m_ks)
6414 ndomains = SIZE(domain_s_inv, 1)
6415
6416 IF (nspins == 1) THEN
6417 spin_factor = 2.0_dp
6418 ELSE
6419 spin_factor = 1.0_dp
6420 END IF
6421
6422 ALLOCATE (domain_prec(ndomains, nspins))
6423 CALL init_submatrices(domain_prec)
6424
6425 ! allocate matrices
6426 ALLOCATE (m_residue(nspins))
6427 ALLOCATE (m_residue_prev(nspins))
6428 ALLOCATE (m_step(nspins))
6429 ALLOCATE (m_zet(nspins))
6430 ALLOCATE (m_zet_prev(nspins))
6431 ALLOCATE (m_hstep(nspins))
6432 ALLOCATE (m_prec(nspins))
6433 ALLOCATE (m_s_vv(nspins))
6434 ALLOCATE (m_f_vv(nspins))
6435 ALLOCATE (m_f_vo(nspins))
6436 ALLOCATE (m_stsiginv(nspins))
6437
6438 ALLOCATE (residue_max_norm(nspins))
6439
6440 ! initiate objects before iterations
6441 DO ispin = 1, nspins
6442
6443 ! init matrices
6444 CALL dbcsr_create(m_residue(ispin), &
6445 template=m_quench_t(ispin), &
6446 matrix_type=dbcsr_type_no_symmetry)
6447 CALL dbcsr_create(m_residue_prev(ispin), &
6448 template=m_quench_t(ispin), &
6449 matrix_type=dbcsr_type_no_symmetry)
6450 CALL dbcsr_create(m_step(ispin), &
6451 template=m_quench_t(ispin), &
6452 matrix_type=dbcsr_type_no_symmetry)
6453 CALL dbcsr_create(m_zet_prev(ispin), &
6454 template=m_quench_t(ispin), &
6455 matrix_type=dbcsr_type_no_symmetry)
6456 CALL dbcsr_create(m_zet(ispin), &
6457 template=m_quench_t(ispin), &
6458 matrix_type=dbcsr_type_no_symmetry)
6459 CALL dbcsr_create(m_hstep(ispin), &
6460 template=m_quench_t(ispin), &
6461 matrix_type=dbcsr_type_no_symmetry)
6462 CALL dbcsr_create(m_f_vo(ispin), &
6463 template=m_quench_t(ispin), &
6464 matrix_type=dbcsr_type_no_symmetry)
6465 CALL dbcsr_create(m_stsiginv(ispin), &
6466 template=m_quench_t(ispin), &
6467 matrix_type=dbcsr_type_no_symmetry)
6468 CALL dbcsr_create(m_f_vv(ispin), &
6469 template=m_ks(ispin), &
6470 matrix_type=dbcsr_type_no_symmetry)
6471 CALL dbcsr_create(m_s_vv(ispin), &
6472 template=m_s(1), &
6473 matrix_type=dbcsr_type_no_symmetry)
6474 CALL dbcsr_create(m_prec(ispin), &
6475 template=m_ks(ispin), &
6476 matrix_type=dbcsr_type_no_symmetry)
6477
6478 ! compute the full "gradient" - it is necessary to
6479 ! evaluate Hessian.X
6480 CALL dbcsr_copy(m_f_vo(ispin), m_ftsiginv(ispin))
6481 CALL dbcsr_multiply("N", "N", -1.0_dp, &
6482 m_st(ispin), &
6483 m_siginvtftsiginv(ispin), &
6484 1.0_dp, m_f_vo(ispin), &
6485 filter_eps=eps_filter)
6486
6487! RZK-warning
6488
6489! domain_s_inv and domain_r_down are never used with assume_t0_q0x=FALSE
6490 CALL compute_preconditioner( &
6491 domain_prec_out=domain_prec(:, ispin), &
6492 m_prec_out=m_prec(ispin), &
6493 m_ks=m_ks(ispin), &
6494 m_s=m_s(1), &
6495 m_siginv=m_siginv(ispin), &
6496 m_quench_t=m_quench_t(ispin), &
6497 m_ftsiginv=m_ftsiginv(ispin), &
6498 m_siginvtftsiginv=m_siginvtftsiginv(ispin), &
6499 m_st=m_st(ispin), &
6500 m_stsiginv_out=m_stsiginv(ispin), &
6501 m_s_vv_out=m_s_vv(ispin), &
6502 m_f_vv_out=m_f_vv(ispin), &
6503 para_env=para_env, &
6504 blacs_env=blacs_env, &
6505 nocc_of_domain=nocc_of_domain(:, ispin), &
6506 domain_s_inv=domain_s_inv(:, ispin), &
6507 domain_r_down=domain_r_down(:, ispin), &
6508 cpu_of_domain=cpu_of_domain(:), &
6509 domain_map=domain_map(ispin), &
6510 assume_t0_q0x=.false., &
6511 penalty_occ_vol=penalty_occ_vol, &
6512 penalty_occ_vol_prefactor=penalty_occ_vol_prefactor(ispin), &
6513 eps_filter=eps_filter, &
6514 neg_thr=0.5_dp, &
6515 spin_factor=spin_factor, &
6516 special_case=special_case, &
6517 skip_inversion=.false. &
6518 )
6519
6520 ! initial guess
6521 CALL dbcsr_copy(m_delta(ispin), m_quench_t(ispin))
6522 ! in order to use dbcsr_set matrix blocks must exist
6523 CALL dbcsr_set(m_delta(ispin), 0.0_dp)
6524 CALL dbcsr_copy(m_residue(ispin), m_grad(ispin))
6525 CALL dbcsr_scale(m_residue(ispin), -1.0_dp)
6526
6527 do_exact_inversion = .false.
6528 IF (do_exact_inversion) THEN
6529
6530 ! copy grad to m_step temporarily
6531 ! use m_step as input to the inversion routine
6532 CALL dbcsr_copy(m_step(ispin), m_grad(ispin))
6533
6534 ! expensive "exact" inversion of the "nearly-exact" Hessian
6535 ! hopefully returns Z=-H^(-1).G
6536 CALL hessian_diag_apply( &
6537 matrix_grad=m_step(ispin), &
6538 matrix_step=m_zet(ispin), &
6539 matrix_s_ao=m_s_vv(ispin), &
6540 matrix_f_ao=m_f_vv(ispin), &
6541 !matrix_S_ao=m_s(ispin),&
6542 !matrix_F_ao=m_ks(ispin),&
6543 matrix_s_mo=m_siginv(ispin), &
6544 matrix_f_mo=m_siginvtftsiginv(ispin), &
6545 matrix_s_vo=m_stsiginv(ispin), &
6546 matrix_f_vo=m_f_vo(ispin), &
6547 quench_t=m_quench_t(ispin), &
6548 spin_factor=spin_factor, &
6549 eps_zero=eps_filter*10.0_dp, &
6550 penalty_occ_vol=penalty_occ_vol, &
6551 penalty_occ_vol_prefactor=penalty_occ_vol_prefactor(ispin), &
6552 penalty_occ_vol_pf2=penalty_occ_vol_pf2(ispin), &
6553 m_s=m_s(1), &
6554 para_env=para_env, &
6555 blacs_env=blacs_env)
6556
6557 ELSE ! use PCG to solve H.D=-G
6558
6559 IF (use_preconditioner) THEN
6560
6561 IF (special_case == xalmo_case_block_diag .OR. &
6562 special_case == xalmo_case_fully_deloc) THEN
6563
6564 CALL dbcsr_multiply("N", "N", 1.0_dp, &
6565 m_prec(ispin), &
6566 m_residue(ispin), &
6567 0.0_dp, m_zet(ispin), &
6568 filter_eps=eps_filter)
6569
6570 ELSE
6571
6572 CALL apply_domain_operators( &
6573 matrix_in=m_residue(ispin), &
6574 matrix_out=m_zet(ispin), &
6575 operator1=domain_prec(:, ispin), &
6576 dpattern=m_quench_t(ispin), &
6577 map=domain_map(ispin), &
6578 node_of_domain=cpu_of_domain(:), &
6579 my_action=0, &
6580 filter_eps=eps_filter)
6581
6582 END IF ! special_case
6583
6584 ELSE ! do not use preconditioner
6585
6586 CALL dbcsr_copy(m_zet(ispin), m_residue(ispin))
6587
6588 END IF ! use_preconditioner
6589
6590 END IF ! do_exact_inversion
6591
6592 CALL dbcsr_copy(m_step(ispin), m_zet(ispin))
6593
6594 END DO !ispin
6595
6596 ! start the outer SCF loop
6597 outer_prepare_to_exit = .false.
6598 outer_iteration = 0
6599 residue_norm = 0.0_dp
6600
6601 DO
6602
6603 ! start the inner SCF loop
6604 prepare_to_exit = .false.
6605 converged = .false.
6606 iteration = 0
6607 t1 = m_walltime()
6608
6609 DO
6610
6611 ! apply hessian to the step matrix
6612 CALL apply_hessian( &
6613 m_x_in=m_step, &
6614 m_x_out=m_hstep, &
6615 m_ks=m_ks, &
6616 m_s=m_s, &
6617 m_siginv=m_siginv, &
6618 m_quench_t=m_quench_t, &
6619 m_ftsiginv=m_ftsiginv, &
6620 m_siginvtftsiginv=m_siginvtftsiginv, &
6621 m_st=m_st, &
6622 m_stsiginv=m_stsiginv, &
6623 m_s_vv=m_s_vv, &
6624 m_ks_vv=m_f_vv, &
6625 !m_s_vv=m_s,&
6626 !m_ks_vv=m_ks,&
6627 m_g_full=m_f_vo, &
6628 m_t=m_t, &
6629 m_sig_sqrti_ii=m_sig_sqrti_ii, &
6630 penalty_occ_vol=penalty_occ_vol, &
6631 normalize_orbitals=normalize_orbitals, &
6632 penalty_occ_vol_prefactor=penalty_occ_vol_prefactor, &
6633 eps_filter=eps_filter, &
6634 path_num=hessian_path_reuse)
6635
6636 ! alpha is computed outside the spin loop
6637 numer = 0.0_dp
6638 denom = 0.0_dp
6639 DO ispin = 1, nspins
6640
6641 CALL dbcsr_dot(m_residue(ispin), m_zet(ispin), numer_ispin)
6642 CALL dbcsr_dot(m_step(ispin), m_hstep(ispin), denom_ispin)
6643
6644 numer = numer + numer_ispin
6645 denom = denom + denom_ispin
6646
6647 END DO !ispin
6648
6649 alpha = numer/denom
6650
6651 DO ispin = 1, nspins
6652
6653 ! update the variable
6654 CALL dbcsr_add(m_delta(ispin), m_step(ispin), 1.0_dp, alpha)
6655 CALL dbcsr_copy(m_residue_prev(ispin), m_residue(ispin))
6656 CALL dbcsr_add(m_residue(ispin), m_hstep(ispin), &
6657 1.0_dp, -1.0_dp*alpha)
6658 residue_max_norm(ispin) = dbcsr_maxabs(m_residue(ispin))
6659
6660 END DO ! ispin
6661
6662 ! check convergence and other exit criteria
6663 residue_norm = maxval(residue_max_norm)
6664 converged = (residue_norm < eps_error_target)
6665 IF (converged .OR. (iteration >= max_iter)) THEN
6666 prepare_to_exit = .true.
6667 END IF
6668
6669 IF (.NOT. prepare_to_exit) THEN
6670
6671 DO ispin = 1, nspins
6672
6673 ! save current z before the update
6674 CALL dbcsr_copy(m_zet_prev(ispin), m_zet(ispin))
6675
6676 ! compute the new step (apply preconditioner if available)
6677 IF (use_preconditioner) THEN
6678
6679 IF (special_case == xalmo_case_block_diag .OR. &
6680 special_case == xalmo_case_fully_deloc) THEN
6681
6682 CALL dbcsr_multiply("N", "N", 1.0_dp, &
6683 m_prec(ispin), &
6684 m_residue(ispin), &
6685 0.0_dp, m_zet(ispin), &
6686 filter_eps=eps_filter)
6687
6688 ELSE
6689
6690 CALL apply_domain_operators( &
6691 matrix_in=m_residue(ispin), &
6692 matrix_out=m_zet(ispin), &
6693 operator1=domain_prec(:, ispin), &
6694 dpattern=m_quench_t(ispin), &
6695 map=domain_map(ispin), &
6696 node_of_domain=cpu_of_domain(:), &
6697 my_action=0, &
6698 filter_eps=eps_filter)
6699
6700 END IF ! special case
6701
6702 ELSE
6703
6704 CALL dbcsr_copy(m_zet(ispin), m_residue(ispin))
6705
6706 END IF
6707
6708 END DO !ispin
6709
6710 ! compute the conjugation coefficient - beta
6711 CALL compute_cg_beta( &
6712 beta=beta, &
6713 reset_conjugator=reset_conjugator, &
6714 conjugator=cg_fletcher, &
6715 grad=m_residue, &
6716 prev_grad=m_residue_prev, &
6717 step=m_zet, &
6718 prev_step=m_zet_prev)
6719
6720 DO ispin = 1, nspins
6721
6722 ! conjugate the step direction
6723 CALL dbcsr_add(m_step(ispin), m_zet(ispin), beta, 1.0_dp)
6724
6725 END DO !ispin
6726
6727 END IF ! not.prepare_to_exit
6728
6729 t2 = m_walltime()
6730 IF (unit_nr > 0) THEN
6731 iter_type = trim("NR STEP")
6732 WRITE (unit_nr, '(T6,A9,I6,F14.5,F14.5,F15.10,F9.2)') &
6733 iter_type, iteration, &
6734 alpha, beta, residue_norm, &
6735 t2 - t1
6736 END IF
6737 t1 = m_walltime()
6738
6739 iteration = iteration + 1
6740 IF (prepare_to_exit) EXIT
6741
6742 END DO ! inner loop
6743
6744 IF (converged .OR. (outer_iteration >= outer_max_iter)) THEN
6745 outer_prepare_to_exit = .true.
6746 END IF
6747
6748 outer_iteration = outer_iteration + 1
6749 IF (outer_prepare_to_exit) EXIT
6750
6751 END DO ! outer loop
6752
6753 DO ispin = 1, nspins
6754
6755 ! check whether the step lies entirely in R or Q
6756 CALL dbcsr_create(m_tmp_oo_1, &
6757 template=m_siginv(ispin), &
6758 matrix_type=dbcsr_type_no_symmetry)
6759 CALL dbcsr_create(m_tmp_oo_2, &
6760 template=m_siginv(ispin), &
6761 matrix_type=dbcsr_type_no_symmetry)
6762 CALL dbcsr_multiply("T", "N", 1.0_dp, &
6763 m_st(ispin), &
6764 m_delta(ispin), &
6765 0.0_dp, m_tmp_oo_1, &
6766 filter_eps=eps_filter)
6767 CALL dbcsr_multiply("N", "N", 1.0_dp, &
6768 m_siginv(ispin), &
6769 m_tmp_oo_1, &
6770 0.0_dp, m_tmp_oo_2, &
6771 filter_eps=eps_filter)
6772 CALL dbcsr_copy(m_zet(ispin), m_quench_t(ispin))
6773 CALL dbcsr_multiply("N", "N", 1.0_dp, &
6774 m_t(ispin), &
6775 m_tmp_oo_2, &
6776 0.0_dp, m_zet(ispin), &
6777 retain_sparsity=.true.)
6778 alpha = dbcsr_maxabs(m_zet(ispin))
6779 WRITE (unit_nr, "(A50,2F20.10)") "Occupied-space projection of the step", alpha
6780 CALL dbcsr_add(m_zet(ispin), m_delta(ispin), -1.0_dp, 1.0_dp)
6781 alpha = dbcsr_maxabs(m_zet(ispin))
6782 WRITE (unit_nr, "(A50,2F20.10)") "Virtual-space projection of the step", alpha
6783 alpha = dbcsr_maxabs(m_delta(ispin))
6784 WRITE (unit_nr, "(A50,2F20.10)") "Full step", alpha
6785 CALL dbcsr_release(m_tmp_oo_1)
6786 CALL dbcsr_release(m_tmp_oo_2)
6787
6788 END DO
6789
6790 ! clean up
6791 DO ispin = 1, nspins
6792 CALL release_submatrices(domain_prec(:, ispin))
6793 CALL dbcsr_release(m_residue(ispin))
6794 CALL dbcsr_release(m_residue_prev(ispin))
6795 CALL dbcsr_release(m_step(ispin))
6796 CALL dbcsr_release(m_zet(ispin))
6797 CALL dbcsr_release(m_zet_prev(ispin))
6798 CALL dbcsr_release(m_hstep(ispin))
6799 CALL dbcsr_release(m_f_vo(ispin))
6800 CALL dbcsr_release(m_f_vv(ispin))
6801 CALL dbcsr_release(m_s_vv(ispin))
6802 CALL dbcsr_release(m_prec(ispin))
6803 CALL dbcsr_release(m_stsiginv(ispin))
6804 END DO !ispin
6805 DEALLOCATE (domain_prec)
6806 DEALLOCATE (m_residue)
6807 DEALLOCATE (m_residue_prev)
6808 DEALLOCATE (m_step)
6809 DEALLOCATE (m_zet)
6810 DEALLOCATE (m_zet_prev)
6811 DEALLOCATE (m_prec)
6812 DEALLOCATE (m_hstep)
6813 DEALLOCATE (m_s_vv)
6814 DEALLOCATE (m_f_vv)
6815 DEALLOCATE (m_f_vo)
6816 DEALLOCATE (m_stsiginv)
6817 DEALLOCATE (residue_max_norm)
6818
6819 IF (.NOT. converged) THEN
6820 cpabort("Optimization not converged!")
6821 END IF
6822
6823 ! check that the step satisfies H.step=-grad
6824
6825 CALL timestop(handle)
6826
6827 END SUBROUTINE newton_grad_to_step
6828
6829! *****************************************************************************
6830!> \brief Computes Hessian.X
6831!> \param m_x_in ...
6832!> \param m_x_out ...
6833!> \param m_ks ...
6834!> \param m_s ...
6835!> \param m_siginv ...
6836!> \param m_quench_t ...
6837!> \param m_FTsiginv ...
6838!> \param m_siginvTFTsiginv ...
6839!> \param m_ST ...
6840!> \param m_STsiginv ...
6841!> \param m_s_vv ...
6842!> \param m_ks_vv ...
6843!> \param m_g_full ...
6844!> \param m_t ...
6845!> \param m_sig_sqrti_ii ...
6846!> \param penalty_occ_vol ...
6847!> \param normalize_orbitals ...
6848!> \param penalty_occ_vol_prefactor ...
6849!> \param eps_filter ...
6850!> \param path_num ...
6851!> \par History
6852!> 2015.04 created [Rustam Z Khaliullin]
6853!> \author Rustam Z Khaliullin
6854! **************************************************************************************************
6855 SUBROUTINE apply_hessian(m_x_in, m_x_out, m_ks, m_s, m_siginv, &
6856 m_quench_t, m_FTsiginv, m_siginvTFTsiginv, m_ST, m_STsiginv, m_s_vv, &
6857 m_ks_vv, m_g_full, m_t, m_sig_sqrti_ii, penalty_occ_vol, &
6858 normalize_orbitals, penalty_occ_vol_prefactor, eps_filter, path_num)
6859
6860 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_x_in, m_x_out, m_ks, m_s
6861 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_siginv, m_quench_t, m_ftsiginv, &
6862 m_siginvtftsiginv, m_st, m_stsiginv
6863 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_s_vv, m_ks_vv, m_g_full
6864 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_t, m_sig_sqrti_ii
6865 LOGICAL, INTENT(IN) :: penalty_occ_vol, normalize_orbitals
6866 REAL(kind=dp), DIMENSION(:), INTENT(IN) :: penalty_occ_vol_prefactor
6867 REAL(kind=dp), INTENT(IN) :: eps_filter
6868 INTEGER, INTENT(IN) :: path_num
6869
6870 CHARACTER(len=*), PARAMETER :: routinen = 'apply_hessian'
6871
6872 INTEGER :: dim0, handle, ispin, nspins
6873 REAL(kind=dp) :: penalty_prefactor_local, spin_factor
6874 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: tg_diagonal
6875 TYPE(dbcsr_type) :: m_tmp_no_1, m_tmp_no_2, m_tmp_oo_1, &
6876 m_tmp_x_in
6877
6878 CALL timeset(routinen, handle)
6879
6880 !JHU: test and use for unused debug variables
6881 IF (penalty_occ_vol) penalty_prefactor_local = 1._dp
6882 cpassert(SIZE(m_stsiginv) >= 0)
6883 cpassert(SIZE(m_siginvtftsiginv) >= 0)
6884 cpassert(SIZE(m_s) >= 0)
6885 cpassert(SIZE(m_g_full) >= 0)
6886 cpassert(SIZE(m_ftsiginv) >= 0)
6887 mark_used(m_siginvtftsiginv)
6888 mark_used(m_stsiginv)
6889 mark_used(m_ftsiginv)
6890 mark_used(m_g_full)
6891 mark_used(m_s)
6892
6893 nspins = SIZE(m_ks)
6894
6895 IF (nspins == 1) THEN
6896 spin_factor = 2.0_dp
6897 ELSE
6898 spin_factor = 1.0_dp
6899 END IF
6900
6901 DO ispin = 1, nspins
6902
6903 penalty_prefactor_local = penalty_occ_vol_prefactor(ispin)/(2.0_dp*spin_factor)
6904
6905 CALL dbcsr_create(m_tmp_oo_1, &
6906 template=m_siginv(ispin), &
6907 matrix_type=dbcsr_type_no_symmetry)
6908 CALL dbcsr_create(m_tmp_no_1, &
6909 template=m_quench_t(ispin), &
6910 matrix_type=dbcsr_type_no_symmetry)
6911 CALL dbcsr_create(m_tmp_no_2, &
6912 template=m_quench_t(ispin), &
6913 matrix_type=dbcsr_type_no_symmetry)
6914 CALL dbcsr_create(m_tmp_x_in, &
6915 template=m_quench_t(ispin), &
6916 matrix_type=dbcsr_type_no_symmetry)
6917
6918 ! transform the input X to take into account the normalization constraint
6919 IF (normalize_orbitals) THEN
6920
6921 ! H.D = ( (H.D) - ST.[tr(T).(H.D)]_ii ) . [sig_sqrti]_ii
6922
6923 ! get [tr(T).HD]_ii
6924 CALL dbcsr_copy(m_tmp_oo_1, m_sig_sqrti_ii(ispin))
6925 CALL dbcsr_multiply("T", "N", 1.0_dp, &
6926 m_x_in(ispin), &
6927 m_st(ispin), &
6928 0.0_dp, m_tmp_oo_1, &
6929 retain_sparsity=.true.)
6930 CALL dbcsr_get_info(m_sig_sqrti_ii(ispin), nfullrows_total=dim0)
6931 ALLOCATE (tg_diagonal(dim0))
6932 CALL dbcsr_get_diag(m_tmp_oo_1, tg_diagonal)
6933 CALL dbcsr_set(m_tmp_oo_1, 0.0_dp)
6934 CALL dbcsr_set_diag(m_tmp_oo_1, tg_diagonal)
6935 DEALLOCATE (tg_diagonal)
6936
6937 CALL dbcsr_copy(m_tmp_no_1, m_x_in(ispin))
6938 CALL dbcsr_multiply("N", "N", -1.0_dp, &
6939 m_t(ispin), &
6940 m_tmp_oo_1, &
6941 1.0_dp, m_tmp_no_1, &
6942 filter_eps=eps_filter)
6943 CALL dbcsr_multiply("N", "N", 1.0_dp, &
6944 m_tmp_no_1, &
6945 m_sig_sqrti_ii(ispin), &
6946 0.0_dp, m_tmp_x_in, &
6947 filter_eps=eps_filter)
6948
6949 ELSE
6950
6951 CALL dbcsr_copy(m_tmp_x_in, m_x_in(ispin))
6952
6953 END IF ! normalize_orbitals
6954
6955 IF (path_num == hessian_path_reuse) THEN
6956
6957 ! apply pre-computed F_vv and S_vv to X
6958
6959 ! debugging: only vv matrices, oo matrices are kronecker
6960 CALL dbcsr_copy(m_x_out(ispin), m_quench_t(ispin))
6961 CALL dbcsr_multiply("N", "N", 1.0_dp, &
6962 m_ks_vv(ispin), &
6963 m_tmp_x_in, &
6964 0.0_dp, m_x_out(ispin), &
6965 retain_sparsity=.true.)
6966
6967 CALL dbcsr_copy(m_tmp_no_2, m_quench_t(ispin))
6968 CALL dbcsr_multiply("N", "N", 1.0_dp, &
6969 m_s_vv(ispin), &
6970 m_tmp_x_in, &
6971 0.0_dp, m_tmp_no_2, &
6972 retain_sparsity=.true.)
6973 CALL dbcsr_add(m_x_out(ispin), m_tmp_no_2, &
6974 1.0_dp, -4.0_dp*penalty_prefactor_local + 1.0_dp)
6975
6976 ELSE IF (path_num == hessian_path_assemble) THEN
6977
6978 ! compute F_vv.X and S_vv.X directly
6979 ! this path will be advantageous if the number
6980 ! of PCG iterations is small
6981 cpabort("path is NYI")
6982
6983 ELSE
6984 cpabort("illegal path")
6985 END IF ! path
6986
6987 ! transform the output to take into account the normalization constraint
6988 IF (normalize_orbitals) THEN
6989
6990 ! H.D = ( (H.D) - ST.[tr(T).(H.D)]_ii ) . [sig_sqrti]_ii
6991
6992 ! get [tr(T).HD]_ii
6993 CALL dbcsr_copy(m_tmp_oo_1, m_sig_sqrti_ii(ispin))
6994 CALL dbcsr_multiply("T", "N", 1.0_dp, &
6995 m_t(ispin), &
6996 m_x_out(ispin), &
6997 0.0_dp, m_tmp_oo_1, &
6998 retain_sparsity=.true.)
6999 CALL dbcsr_get_info(m_sig_sqrti_ii(ispin), nfullrows_total=dim0)
7000 ALLOCATE (tg_diagonal(dim0))
7001 CALL dbcsr_get_diag(m_tmp_oo_1, tg_diagonal)
7002 CALL dbcsr_set(m_tmp_oo_1, 0.0_dp)
7003 CALL dbcsr_set_diag(m_tmp_oo_1, tg_diagonal)
7004 DEALLOCATE (tg_diagonal)
7005
7006 CALL dbcsr_multiply("N", "N", -1.0_dp, &
7007 m_st(ispin), &
7008 m_tmp_oo_1, &
7009 1.0_dp, m_x_out(ispin), &
7010 retain_sparsity=.true.)
7011 CALL dbcsr_copy(m_tmp_no_1, m_x_out(ispin))
7012 CALL dbcsr_multiply("N", "N", 1.0_dp, &
7013 m_tmp_no_1, &
7014 m_sig_sqrti_ii(ispin), &
7015 0.0_dp, m_x_out(ispin), &
7016 retain_sparsity=.true.)
7017
7018 END IF ! normalize_orbitals
7019
7020 CALL dbcsr_scale(m_x_out(ispin), &
7021 2.0_dp*spin_factor)
7022
7023 CALL dbcsr_release(m_tmp_oo_1)
7024 CALL dbcsr_release(m_tmp_no_1)
7025 CALL dbcsr_release(m_tmp_no_2)
7026 CALL dbcsr_release(m_tmp_x_in)
7027
7028 END DO !ispin
7029
7030 ! there is one more part of the hessian that comes
7031 ! from T-dependence of the KS matrix
7032 ! it is neglected here
7033
7034 CALL timestop(handle)
7035
7036 END SUBROUTINE apply_hessian
7037
7038! *****************************************************************************
7039!> \brief Serial code that constructs an approximate Hessian
7040!> \param matrix_grad ...
7041!> \param matrix_step ...
7042!> \param matrix_S_ao ...
7043!> \param matrix_F_ao ...
7044!> \param matrix_S_mo ...
7045!> \param matrix_F_mo ...
7046!> \param matrix_S_vo ...
7047!> \param matrix_F_vo ...
7048!> \param quench_t ...
7049!> \param penalty_occ_vol ...
7050!> \param penalty_occ_vol_prefactor ...
7051!> \param penalty_occ_vol_pf2 ...
7052!> \param spin_factor ...
7053!> \param eps_zero ...
7054!> \param m_s ...
7055!> \param para_env ...
7056!> \param blacs_env ...
7057!> \par History
7058!> 2012.02 created [Rustam Z. Khaliullin]
7059!> \author Rustam Z. Khaliullin
7060! **************************************************************************************************
7061 SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, &
7062 matrix_F_ao, matrix_S_mo, matrix_F_mo, matrix_S_vo, matrix_F_vo, quench_t, &
7063 penalty_occ_vol, penalty_occ_vol_prefactor, penalty_occ_vol_pf2, &
7064 spin_factor, eps_zero, m_s, para_env, blacs_env)
7065
7066 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_grad, matrix_step, matrix_s_ao, &
7067 matrix_f_ao, matrix_s_mo
7068 TYPE(dbcsr_type), INTENT(IN) :: matrix_f_mo
7069 TYPE(dbcsr_type), INTENT(INOUT) :: matrix_s_vo, matrix_f_vo, quench_t
7070 LOGICAL, INTENT(IN) :: penalty_occ_vol
7071 REAL(kind=dp), INTENT(IN) :: penalty_occ_vol_prefactor, &
7072 penalty_occ_vol_pf2, spin_factor, &
7073 eps_zero
7074 TYPE(dbcsr_type), INTENT(IN) :: m_s
7075 TYPE(mp_para_env_type), POINTER :: para_env
7076 TYPE(cp_blacs_env_type), POINTER :: blacs_env
7077
7078 CHARACTER(len=*), PARAMETER :: routinen = 'hessian_diag_apply'
7079
7080 INTEGER :: ao_hori_offset, ao_vert_offset, block_col, block_row, col, h_size, handle, ii, &
7081 info, jj, lev1_hori_offset, lev1_vert_offset, lev2_hori_offset, lev2_vert_offset, lwork, &
7082 nblkcols_tot, nblkrows_tot, ncores, orb_i, orb_j, row, unit_nr, zero_neg_eiv
7083 INTEGER, ALLOCATABLE, DIMENSION(:) :: ao_block_sizes, ao_domain_sizes, &
7084 mo_block_sizes
7085 INTEGER, DIMENSION(:), POINTER :: ao_blk_sizes, mo_blk_sizes
7086 LOGICAL :: found, found_col, found_row
7087 REAL(kind=dp) :: penalty_prefactor_local, test_error
7088 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues, grad_vec, step_vec, tmp, &
7089 tmpr, work
7090 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: f_ao_block, f_mo_block, h, hinv, &
7091 new_block, s_ao_block, s_mo_block, &
7092 test, test2
7093 REAL(kind=dp), DIMENSION(:, :), POINTER :: block_p
7094 TYPE(cp_logger_type), POINTER :: logger
7095 TYPE(dbcsr_distribution_type) :: main_dist
7096 TYPE(dbcsr_type) :: matrix_f_ao_sym, matrix_f_mo_sym, &
7097 matrix_s_ao_sym, matrix_s_mo_sym
7098
7099 CALL timeset(routinen, handle)
7100
7101 ! get a useful output_unit
7102 logger => cp_get_default_logger()
7103 IF (logger%para_env%is_source()) THEN
7104 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
7105 ELSE
7106 unit_nr = -1
7107 END IF
7108
7109 !JHU use and test for unused debug variables
7110 cpassert(ASSOCIATED(blacs_env))
7111 cpassert(ASSOCIATED(para_env))
7112 mark_used(blacs_env)
7113 mark_used(para_env)
7114
7115 CALL dbcsr_get_info(m_s, row_blk_size=ao_blk_sizes)
7116 CALL dbcsr_get_info(matrix_s_vo, row_blk_size=ao_blk_sizes)
7117 CALL dbcsr_get_info(matrix_f_vo, row_blk_size=ao_blk_sizes)
7118
7119 ! serial code only
7120 CALL dbcsr_get_info(matrix=matrix_s_ao, distribution=main_dist)
7121 CALL dbcsr_distribution_get(main_dist, numnodes=ncores)
7122 IF (ncores > 1) THEN
7123 cpabort("serial code only")
7124 END IF
7125
7126 CALL dbcsr_get_info(quench_t, row_blk_size=ao_blk_sizes, col_blk_size=mo_blk_sizes, &
7127 nblkrows_total=nblkrows_tot, nblkcols_total=nblkcols_tot)
7128 cpassert(nblkrows_tot == nblkcols_tot)
7129 ALLOCATE (mo_block_sizes(nblkcols_tot), ao_block_sizes(nblkcols_tot))
7130 ALLOCATE (ao_domain_sizes(nblkcols_tot))
7131 mo_block_sizes(:) = mo_blk_sizes(:)
7132 ao_block_sizes(:) = ao_blk_sizes(:)
7133 ao_domain_sizes(:) = 0
7134
7135 CALL dbcsr_create(matrix_s_ao_sym, &
7136 template=matrix_s_ao, &
7137 matrix_type=dbcsr_type_no_symmetry)
7138 CALL dbcsr_desymmetrize(matrix_s_ao, matrix_s_ao_sym)
7139 CALL dbcsr_scale(matrix_s_ao_sym, 2.0_dp*spin_factor)
7140
7141 CALL dbcsr_create(matrix_f_ao_sym, &
7142 template=matrix_f_ao, &
7143 matrix_type=dbcsr_type_no_symmetry)
7144 CALL dbcsr_desymmetrize(matrix_f_ao, matrix_f_ao_sym)
7145 CALL dbcsr_scale(matrix_f_ao_sym, 2.0_dp*spin_factor)
7146
7147 CALL dbcsr_create(matrix_s_mo_sym, &
7148 template=matrix_s_mo, &
7149 matrix_type=dbcsr_type_no_symmetry)
7150 CALL dbcsr_desymmetrize(matrix_s_mo, matrix_s_mo_sym)
7151
7152 CALL dbcsr_create(matrix_f_mo_sym, &
7153 template=matrix_f_mo, &
7154 matrix_type=dbcsr_type_no_symmetry)
7155 CALL dbcsr_desymmetrize(matrix_f_mo, matrix_f_mo_sym)
7156
7157 IF (penalty_occ_vol) THEN
7158 penalty_prefactor_local = penalty_occ_vol_prefactor/(2.0_dp*spin_factor)
7159 ELSE
7160 penalty_prefactor_local = 0.0_dp
7161 END IF
7162
7163 WRITE (unit_nr, *) "penalty_prefactor_local: ", penalty_prefactor_local
7164 WRITE (unit_nr, *) "penalty_prefactor_2: ", penalty_occ_vol_pf2
7165
7166 ! loop over domains to find the size of the Hessian
7167 h_size = 0
7168 DO col = 1, nblkcols_tot
7169
7170 ! find sizes of AO submatrices
7171 DO row = 1, nblkrows_tot
7172
7173 CALL dbcsr_get_block_p(quench_t, &
7174 row, col, block_p, found)
7175 IF (found) THEN
7176 ao_domain_sizes(col) = ao_domain_sizes(col) + ao_blk_sizes(row)
7177 END IF
7178
7179 END DO
7180
7181 h_size = h_size + ao_domain_sizes(col)*mo_block_sizes(col)
7182
7183 END DO
7184
7185 ALLOCATE (h(h_size, h_size))
7186 h(:, :) = 0.0_dp
7187
7188 ! fill the Hessian matrix
7189 lev1_vert_offset = 0
7190 ! loop over all pairs of fragments
7191 DO row = 1, nblkcols_tot
7192
7193 lev1_hori_offset = 0
7194 DO col = 1, nblkcols_tot
7195
7196 ! prepare blocks for the current row-column fragment pair
7197 ALLOCATE (f_ao_block(ao_domain_sizes(row), ao_domain_sizes(col)))
7198 ALLOCATE (s_ao_block(ao_domain_sizes(row), ao_domain_sizes(col)))
7199 ALLOCATE (f_mo_block(mo_block_sizes(row), mo_block_sizes(col)))
7200 ALLOCATE (s_mo_block(mo_block_sizes(row), mo_block_sizes(col)))
7201
7202 f_ao_block(:, :) = 0.0_dp
7203 s_ao_block(:, :) = 0.0_dp
7204 f_mo_block(:, :) = 0.0_dp
7205 s_mo_block(:, :) = 0.0_dp
7206
7207 ! fill AO submatrices
7208 ! loop over all blocks of the AO dbcsr matrix
7209 ao_vert_offset = 0
7210 DO block_row = 1, nblkcols_tot
7211
7212 CALL dbcsr_get_block_p(quench_t, &
7213 block_row, row, block_p, found_row)
7214 IF (found_row) THEN
7215
7216 ao_hori_offset = 0
7217 DO block_col = 1, nblkcols_tot
7218
7219 CALL dbcsr_get_block_p(quench_t, &
7220 block_col, col, block_p, found_col)
7221 IF (found_col) THEN
7222
7223 CALL dbcsr_get_block_p(matrix_f_ao_sym, &
7224 block_row, block_col, block_p, found)
7225 IF (found) THEN
7226 ! copy the block into the submatrix
7227 f_ao_block(ao_vert_offset + 1:ao_vert_offset + ao_block_sizes(block_row), &
7228 ao_hori_offset + 1:ao_hori_offset + ao_block_sizes(block_col)) &
7229 = block_p(:, :)
7230 END IF
7231
7232 CALL dbcsr_get_block_p(matrix_s_ao_sym, &
7233 block_row, block_col, block_p, found)
7234 IF (found) THEN
7235 ! copy the block into the submatrix
7236 s_ao_block(ao_vert_offset + 1:ao_vert_offset + ao_block_sizes(block_row), &
7237 ao_hori_offset + 1:ao_hori_offset + ao_block_sizes(block_col)) &
7238 = block_p(:, :)
7239 END IF
7240
7241 ao_hori_offset = ao_hori_offset + ao_block_sizes(block_col)
7242
7243 END IF
7244
7245 END DO
7246
7247 ao_vert_offset = ao_vert_offset + ao_block_sizes(block_row)
7248
7249 END IF
7250
7251 END DO
7252
7253 ! fill MO submatrices
7254 CALL dbcsr_get_block_p(matrix_f_mo_sym, row, col, block_p, found)
7255 IF (found) THEN
7256 ! copy the block into the submatrix
7257 f_mo_block(1:mo_block_sizes(row), 1:mo_block_sizes(col)) = block_p(:, :)
7258 END IF
7259 CALL dbcsr_get_block_p(matrix_s_mo_sym, row, col, block_p, found)
7260 IF (found) THEN
7261 ! copy the block into the submatrix
7262 s_mo_block(1:mo_block_sizes(row), 1:mo_block_sizes(col)) = block_p(:, :)
7263 END IF
7264
7265 ! construct tensor products for the current row-column fragment pair
7266 lev2_vert_offset = 0
7267 DO orb_j = 1, mo_block_sizes(row)
7268
7269 lev2_hori_offset = 0
7270 DO orb_i = 1, mo_block_sizes(col)
7271 IF (orb_i == orb_j .AND. row == col) THEN
7272 h(lev1_vert_offset + lev2_vert_offset + 1:lev1_vert_offset + lev2_vert_offset + ao_domain_sizes(row), &
7273 lev1_hori_offset + lev2_hori_offset + 1:lev1_hori_offset + lev2_hori_offset + ao_domain_sizes(col)) &
7274 = f_ao_block(:, :) + s_ao_block(:, :)
7275 END IF
7276
7277 lev2_hori_offset = lev2_hori_offset + ao_domain_sizes(col)
7278
7279 END DO
7280
7281 lev2_vert_offset = lev2_vert_offset + ao_domain_sizes(row)
7282
7283 END DO
7284
7285 lev1_hori_offset = lev1_hori_offset + ao_domain_sizes(col)*mo_block_sizes(col)
7286
7287 DEALLOCATE (f_ao_block)
7288 DEALLOCATE (s_ao_block)
7289 DEALLOCATE (f_mo_block)
7290 DEALLOCATE (s_mo_block)
7291
7292 END DO ! col fragment
7293
7294 lev1_vert_offset = lev1_vert_offset + ao_domain_sizes(row)*mo_block_sizes(row)
7295
7296 END DO ! row fragment
7297
7298 CALL dbcsr_release(matrix_s_ao_sym)
7299 CALL dbcsr_release(matrix_f_ao_sym)
7300 CALL dbcsr_release(matrix_s_mo_sym)
7301 CALL dbcsr_release(matrix_f_mo_sym)
7302
7303 ! convert gradient from the dbcsr matrix to the vector form
7304 ALLOCATE (grad_vec(h_size))
7305 grad_vec(:) = 0.0_dp
7306 lev1_vert_offset = 0
7307 ! loop over all electron blocks
7308 DO col = 1, nblkcols_tot
7309
7310 ! loop over AO-rows of the dbcsr matrix
7311 lev2_vert_offset = 0
7312 DO row = 1, nblkrows_tot
7313
7314 CALL dbcsr_get_block_p(quench_t, &
7315 row, col, block_p, found_row)
7316 IF (found_row) THEN
7317
7318 CALL dbcsr_get_block_p(matrix_grad, &
7319 row, col, block_p, found)
7320 IF (found) THEN
7321 ! copy the data into the vector, column by column
7322 DO orb_i = 1, mo_block_sizes(col)
7323 grad_vec(lev1_vert_offset + ao_domain_sizes(col)*(orb_i - 1) + lev2_vert_offset + 1: &
7324 lev1_vert_offset + ao_domain_sizes(col)*(orb_i - 1) + lev2_vert_offset + ao_block_sizes(row)) &
7325 = block_p(:, orb_i)
7326 END DO
7327
7328 END IF
7329
7330 lev2_vert_offset = lev2_vert_offset + ao_block_sizes(row)
7331
7332 END IF
7333
7334 END DO
7335
7336 lev1_vert_offset = lev1_vert_offset + ao_domain_sizes(col)*mo_block_sizes(col)
7337
7338 END DO ! loop over electron blocks
7339
7340 ! invert the Hessian
7341 info = 0
7342 ALLOCATE (hinv(h_size, h_size))
7343 hinv(:, :) = h(:, :)
7344
7345 ! before inverting diagonalize
7346 ALLOCATE (eigenvalues(h_size))
7347 ! Query the optimal workspace for dsyev
7348 lwork = -1
7349 ALLOCATE (work(max(1, lwork)))
7350 CALL dsyev('V', 'L', h_size, hinv, h_size, eigenvalues, work, lwork, info)
7351 lwork = int(work(1))
7352 DEALLOCATE (work)
7353 ! Allocate the workspace and solve the eigenproblem
7354 ALLOCATE (work(max(1, lwork)))
7355 CALL dsyev('V', 'L', h_size, hinv, h_size, eigenvalues, work, lwork, info)
7356 IF (info /= 0) THEN
7357 WRITE (unit_nr, *) 'DSYEV ERROR MESSAGE: ', info
7358 cpabort("DSYEV failed")
7359 END IF
7360 DEALLOCATE (work)
7361
7362 ! compute grad vector in the basis of Hessian eigenvectors
7363 ALLOCATE (step_vec(h_size))
7364 ! Step_vec contains Grad_vec here
7365 step_vec(:) = matmul(transpose(hinv), grad_vec)
7366
7367 ! invert eigenvalues and use eigenvectors to compute the Hessian inverse
7368 ! project out zero-eigenvalue directions
7369 ALLOCATE (test(h_size, h_size))
7370 zero_neg_eiv = 0
7371 DO jj = 1, h_size
7372 WRITE (unit_nr, "(I10,F20.10,F20.10)") jj, eigenvalues(jj), step_vec(jj)
7373 IF (eigenvalues(jj) > eps_zero) THEN
7374 test(jj, :) = hinv(:, jj)/eigenvalues(jj)
7375 ELSE
7376 test(jj, :) = hinv(:, jj)*0.0_dp
7377 zero_neg_eiv = zero_neg_eiv + 1
7378 END IF
7379 END DO
7380 WRITE (unit_nr, *) 'ZERO OR NEGATIVE EIGENVALUES: ', zero_neg_eiv
7381 DEALLOCATE (step_vec)
7382
7383 ALLOCATE (test2(h_size, h_size))
7384 test2(:, :) = matmul(hinv, test)
7385 hinv(:, :) = test2(:, :)
7386 DEALLOCATE (test, test2)
7387
7388 DEALLOCATE (eigenvalues)
7389
7390 ! compute the inversion error
7391 ALLOCATE (test(h_size, h_size))
7392 test(:, :) = matmul(hinv, h)
7393 DO ii = 1, h_size
7394 test(ii, ii) = test(ii, ii) - 1.0_dp
7395 END DO
7396 test_error = 0.0_dp
7397 DO ii = 1, h_size
7398 DO jj = 1, h_size
7399 test_error = test_error + test(jj, ii)*test(jj, ii)
7400 END DO
7401 END DO
7402 WRITE (unit_nr, *) "Hessian inversion error: ", sqrt(test_error)
7403 DEALLOCATE (test)
7404
7405 ! prepare the output vector
7406 ALLOCATE (step_vec(h_size))
7407 ALLOCATE (tmp(h_size))
7408 tmp(:) = matmul(hinv, grad_vec)
7409 step_vec(:) = -1.0_dp*tmp(:)
7410
7411 ALLOCATE (tmpr(h_size))
7412 tmpr(:) = matmul(h, step_vec)
7413 tmp(:) = tmpr(:) + grad_vec(:)
7414 DEALLOCATE (tmpr)
7415 WRITE (unit_nr, *) "NEWTOV step error: ", maxval(abs(tmp))
7416
7417 DEALLOCATE (tmp)
7418
7419 DEALLOCATE (h)
7420 DEALLOCATE (hinv)
7421 DEALLOCATE (grad_vec)
7422
7423!S-1.G DEALLOCATE(test3)
7424
7425 ! copy the step from the vector into the dbcsr matrix
7426
7427 ! re-create the step matrix to remove all blocks
7428 CALL dbcsr_create(matrix_step, &
7429 template=matrix_grad, &
7430 matrix_type=dbcsr_type_no_symmetry)
7431 CALL dbcsr_work_create(matrix_step, work_mutable=.true.)
7432
7433 lev1_vert_offset = 0
7434 ! loop over all electron blocks
7435 DO col = 1, nblkcols_tot
7436
7437 ! loop over AO-rows of the dbcsr matrix
7438 lev2_vert_offset = 0
7439 DO row = 1, nblkrows_tot
7440
7441 CALL dbcsr_get_block_p(quench_t, &
7442 row, col, block_p, found_row)
7443 IF (found_row) THEN
7444 ! copy the data column by column
7445 ALLOCATE (new_block(ao_block_sizes(row), mo_block_sizes(col)))
7446 DO orb_i = 1, mo_block_sizes(col)
7447 new_block(:, orb_i) = &
7448 step_vec(lev1_vert_offset + ao_domain_sizes(col)*(orb_i - 1) + lev2_vert_offset + 1: &
7449 lev1_vert_offset + ao_domain_sizes(col)*(orb_i - 1) + lev2_vert_offset + ao_block_sizes(row))
7450 END DO
7451 CALL dbcsr_put_block(matrix_step, row, col, new_block)
7452 DEALLOCATE (new_block)
7453 lev2_vert_offset = lev2_vert_offset + ao_block_sizes(row)
7454 END IF
7455
7456 END DO
7457
7458 lev1_vert_offset = lev1_vert_offset + ao_domain_sizes(col)*mo_block_sizes(col)
7459
7460 END DO ! loop over electron blocks
7461
7462 DEALLOCATE (step_vec)
7463
7464 CALL dbcsr_finalize(matrix_step)
7465
7466 DEALLOCATE (mo_block_sizes, ao_block_sizes)
7467 DEALLOCATE (ao_domain_sizes)
7468
7469 CALL dbcsr_create(matrix_s_ao_sym, &
7470 template=quench_t, &
7471 matrix_type=dbcsr_type_no_symmetry)
7472 CALL dbcsr_copy(matrix_s_ao_sym, quench_t)
7473 CALL dbcsr_multiply("N", "N", 1.0_dp, &
7474 matrix_f_ao, &
7475 matrix_step, &
7476 0.0_dp, matrix_s_ao_sym, &
7477 retain_sparsity=.true.)
7478 CALL dbcsr_create(matrix_f_ao_sym, &
7479 template=quench_t, &
7480 matrix_type=dbcsr_type_no_symmetry)
7481 CALL dbcsr_copy(matrix_f_ao_sym, quench_t)
7482 CALL dbcsr_multiply("N", "N", 1.0_dp, &
7483 matrix_s_ao, &
7484 matrix_step, &
7485 0.0_dp, matrix_f_ao_sym, &
7486 retain_sparsity=.true.)
7487 CALL dbcsr_add(matrix_s_ao_sym, matrix_f_ao_sym, &
7488 1.0_dp, 1.0_dp)
7489 CALL dbcsr_scale(matrix_s_ao_sym, 2.0_dp*spin_factor)
7490 CALL dbcsr_add(matrix_s_ao_sym, matrix_grad, &
7491 1.0_dp, 1.0_dp)
7492 test_error = dbcsr_maxabs(matrix_s_ao_sym)
7493 WRITE (unit_nr, *) "NEWTOL step error: ", test_error
7494 CALL dbcsr_release(matrix_s_ao_sym)
7495 CALL dbcsr_release(matrix_f_ao_sym)
7496
7497 CALL timestop(handle)
7498
7499 END SUBROUTINE hessian_diag_apply
7500
7501! **************************************************************************************************
7502!> \brief Optimization of ALMOs using trust region minimizers
7503!> \param qs_env ...
7504!> \param almo_scf_env ...
7505!> \param optimizer controls the optimization algorithm
7506!> \param quench_t ...
7507!> \param matrix_t_in ...
7508!> \param matrix_t_out ...
7509!> \param perturbation_only - perturbative (do not update Hamiltonian)
7510!> \param special_case to reduce the overhead special cases are implemented:
7511!> xalmo_case_normal - no special case (i.e. xALMOs)
7512!> xalmo_case_block_diag
7513!> xalmo_case_fully_deloc
7514!> \par History
7515!> 2020.01 created [Rustam Z Khaliullin]
7516!> \author Rustam Z Khaliullin
7517! **************************************************************************************************
7518 SUBROUTINE almo_scf_xalmo_trustr(qs_env, almo_scf_env, optimizer, quench_t, &
7519 matrix_t_in, matrix_t_out, perturbation_only, &
7520 special_case)
7521
7522 TYPE(qs_environment_type), POINTER :: qs_env
7523 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
7524 TYPE(optimizer_options_type), INTENT(IN) :: optimizer
7525 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: quench_t, matrix_t_in, matrix_t_out
7526 LOGICAL, INTENT(IN) :: perturbation_only
7527 INTEGER, INTENT(IN), OPTIONAL :: special_case
7528
7529 CHARACTER(len=*), PARAMETER :: routinen = 'almo_scf_xalmo_trustr'
7530
7531 INTEGER :: handle, ispin, iteration, iteration_type_to_report, my_special_case, ndomains, &
7532 nspins, outer_iteration, prec_type, unit_nr
7533 INTEGER, ALLOCATABLE, DIMENSION(:) :: nocc
7534 LOGICAL :: assume_t0_q0x, border_reached, inner_loop_success, normalize_orbitals, &
7535 optimize_theta, penalty_occ_vol, reset_conjugator, same_position, scf_converged
7536 REAL(kind=dp) :: beta, energy_start, energy_trial, eta, expected_reduction, &
7537 fake_step_size_to_report, grad_norm_ratio, grad_norm_ref, loss_change_to_report, &
7538 loss_start, loss_trial, model_grad_norm, penalty_amplitude, penalty_start, penalty_trial, &
7539 radius_current, radius_max, real_temp, rho, spin_factor, step_norm, step_size, t1, &
7540 t1outer, t2, t2outer, y_scalar
7541 REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: grad_norm_spin, &
7542 penalty_occ_vol_g_prefactor, &
7543 penalty_occ_vol_h_prefactor
7544 TYPE(cp_logger_type), POINTER :: logger
7545 TYPE(dbcsr_type) :: m_s_inv
7546 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: ftsiginv, grad, m_model_bd, m_model_d, &
7547 m_model_hessian, m_model_hessian_inv, m_model_r, m_model_r_prev, m_model_rt, &
7548 m_model_rt_prev, m_sig_sqrti_ii, m_theta, m_theta_trial, prev_step, siginvtftsiginv, st, &
7549 step, stsiginv_0
7550 TYPE(domain_submatrix_type), ALLOCATABLE, &
7551 DIMENSION(:, :) :: domain_model_hessian_inv, domain_r_down
7552
7553 ! RZK-warning: number of temporary storage matrices can be reduced
7554 CALL timeset(routinen, handle)
7555
7556 t1outer = m_walltime()
7557
7558 my_special_case = xalmo_case_normal
7559 IF (PRESENT(special_case)) my_special_case = special_case
7560
7561 ! get a useful output_unit
7562 logger => cp_get_default_logger()
7563 IF (logger%para_env%is_source()) THEN
7564 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
7565 ELSE
7566 unit_nr = -1
7567 END IF
7568
7569 ! Trust radius code is written to obviate the need in projected orbitals
7570 assume_t0_q0x = .false.
7571 ! Smoothing of the orbitals have not been implemented
7572 optimize_theta = .false.
7573
7574 nspins = almo_scf_env%nspins
7575 IF (nspins == 1) THEN
7576 spin_factor = 2.0_dp
7577 ELSE
7578 spin_factor = 1.0_dp
7579 END IF
7580
7581 IF (unit_nr > 0) THEN
7582 WRITE (unit_nr, *)
7583 SELECT CASE (my_special_case)
7584 CASE (xalmo_case_block_diag)
7585 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 20), &
7586 " Optimization of block-diagonal ALMOs ", repeat("-", 21)
7587 CASE (xalmo_case_fully_deloc)
7588 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 20), &
7589 " Optimization of fully delocalized MOs ", repeat("-", 20)
7590 CASE (xalmo_case_normal)
7591 WRITE (unit_nr, '(T2,A,A,A)') repeat("-", 27), &
7592 " Optimization of XALMOs ", repeat("-", 28)
7593 END SELECT
7594 WRITE (unit_nr, *)
7595 CALL trust_r_report(unit_nr, &
7596 iter_type=0, & ! print header, all values are ignored
7597 iteration=0, &
7598 radius=0.0_dp, &
7599 loss=0.0_dp, &
7600 delta_loss=0.0_dp, &
7601 grad_norm=0.0_dp, &
7602 predicted_reduction=0.0_dp, &
7603 rho=0.0_dp, &
7604 new=.true., &
7605 time=0.0_dp)
7606 WRITE (unit_nr, '(T2,A)') repeat("-", 79)
7607 END IF
7608
7609 ! penalty amplitude adjusts the strength of volume conservation
7610 penalty_occ_vol = .false.
7611 normalize_orbitals = penalty_occ_vol
7612 penalty_amplitude = 0.0_dp !almo_scf_env%penalty%occ_vol_coeff
7613 ALLOCATE (penalty_occ_vol_g_prefactor(nspins))
7614 ALLOCATE (penalty_occ_vol_h_prefactor(nspins))
7615 penalty_occ_vol_g_prefactor(:) = 0.0_dp
7616 penalty_occ_vol_h_prefactor(:) = 0.0_dp
7617
7618 ! here preconditioner is the Hessian of model function
7619 prec_type = optimizer%preconditioner
7620
7621 ALLOCATE (grad_norm_spin(nspins))
7622 ALLOCATE (nocc(nspins))
7623
7624 ! m_theta contains a set of variational parameters
7625 ! that define one-electron orbitals (simple, projected, etc.)
7626 ALLOCATE (m_theta(nspins))
7627 DO ispin = 1, nspins
7628 CALL dbcsr_create(m_theta(ispin), &
7629 template=matrix_t_out(ispin), &
7630 matrix_type=dbcsr_type_no_symmetry)
7631 END DO
7632
7633 ! create initial guess from the initial orbitals
7634 CALL xalmo_initial_guess(m_guess=m_theta, &
7635 m_t_in=matrix_t_in, &
7636 m_t0=almo_scf_env%matrix_t_blk, &
7637 m_quench_t=quench_t, &
7638 m_overlap=almo_scf_env%matrix_s(1), &
7639 m_sigma_tmpl=almo_scf_env%matrix_sigma_inv, &
7640 nspins=nspins, &
7641 xalmo_history=almo_scf_env%xalmo_history, &
7642 assume_t0_q0x=assume_t0_q0x, &
7643 optimize_theta=optimize_theta, &
7644 envelope_amplitude=almo_scf_env%envelope_amplitude, &
7645 eps_filter=almo_scf_env%eps_filter, &
7646 order_lanczos=almo_scf_env%order_lanczos, &
7647 eps_lanczos=almo_scf_env%eps_lanczos, &
7648 max_iter_lanczos=almo_scf_env%max_iter_lanczos, &
7649 nocc_of_domain=almo_scf_env%nocc_of_domain)
7650
7651 ndomains = almo_scf_env%ndomains
7652 ALLOCATE (domain_r_down(ndomains, nspins))
7653 CALL init_submatrices(domain_r_down)
7654 ALLOCATE (domain_model_hessian_inv(ndomains, nspins))
7655 CALL init_submatrices(domain_model_hessian_inv)
7656
7657 ALLOCATE (m_model_hessian(nspins))
7658 ALLOCATE (m_model_hessian_inv(nspins))
7659 ALLOCATE (siginvtftsiginv(nspins))
7660 ALLOCATE (stsiginv_0(nspins))
7661 ALLOCATE (ftsiginv(nspins))
7662 ALLOCATE (st(nspins))
7663 ALLOCATE (grad(nspins))
7664 ALLOCATE (prev_step(nspins))
7665 ALLOCATE (step(nspins))
7666 ALLOCATE (m_sig_sqrti_ii(nspins))
7667 ALLOCATE (m_model_r(nspins))
7668 ALLOCATE (m_model_rt(nspins))
7669 ALLOCATE (m_model_d(nspins))
7670 ALLOCATE (m_model_bd(nspins))
7671 ALLOCATE (m_model_r_prev(nspins))
7672 ALLOCATE (m_model_rt_prev(nspins))
7673 ALLOCATE (m_theta_trial(nspins))
7674
7675 DO ispin = 1, nspins
7676
7677 ! init temporary storage
7678 CALL dbcsr_create(m_model_hessian_inv(ispin), &
7679 template=almo_scf_env%matrix_ks(ispin), &
7680 matrix_type=dbcsr_type_no_symmetry)
7681 CALL dbcsr_create(m_model_hessian(ispin), &
7682 template=almo_scf_env%matrix_ks(ispin), &
7683 matrix_type=dbcsr_type_no_symmetry)
7684 CALL dbcsr_create(siginvtftsiginv(ispin), &
7685 template=almo_scf_env%matrix_sigma(ispin), &
7686 matrix_type=dbcsr_type_no_symmetry)
7687 CALL dbcsr_create(stsiginv_0(ispin), &
7688 template=matrix_t_out(ispin), &
7689 matrix_type=dbcsr_type_no_symmetry)
7690 CALL dbcsr_create(ftsiginv(ispin), &
7691 template=matrix_t_out(ispin), &
7692 matrix_type=dbcsr_type_no_symmetry)
7693 CALL dbcsr_create(st(ispin), &
7694 template=matrix_t_out(ispin), &
7695 matrix_type=dbcsr_type_no_symmetry)
7696 CALL dbcsr_create(grad(ispin), &
7697 template=matrix_t_out(ispin), &
7698 matrix_type=dbcsr_type_no_symmetry)
7699 CALL dbcsr_create(prev_step(ispin), &
7700 template=matrix_t_out(ispin), &
7701 matrix_type=dbcsr_type_no_symmetry)
7702 CALL dbcsr_create(step(ispin), &
7703 template=matrix_t_out(ispin), &
7704 matrix_type=dbcsr_type_no_symmetry)
7705 CALL dbcsr_create(m_sig_sqrti_ii(ispin), &
7706 template=almo_scf_env%matrix_sigma_inv(ispin), &
7707 matrix_type=dbcsr_type_no_symmetry)
7708 CALL dbcsr_create(m_model_r(ispin), &
7709 template=matrix_t_out(ispin), &
7710 matrix_type=dbcsr_type_no_symmetry)
7711 CALL dbcsr_create(m_model_rt(ispin), &
7712 template=matrix_t_out(ispin), &
7713 matrix_type=dbcsr_type_no_symmetry)
7714 CALL dbcsr_create(m_model_d(ispin), &
7715 template=matrix_t_out(ispin), &
7716 matrix_type=dbcsr_type_no_symmetry)
7717 CALL dbcsr_create(m_model_bd(ispin), &
7718 template=matrix_t_out(ispin), &
7719 matrix_type=dbcsr_type_no_symmetry)
7720 CALL dbcsr_create(m_model_r_prev(ispin), &
7721 template=matrix_t_out(ispin), &
7722 matrix_type=dbcsr_type_no_symmetry)
7723 CALL dbcsr_create(m_model_rt_prev(ispin), &
7724 template=matrix_t_out(ispin), &
7725 matrix_type=dbcsr_type_no_symmetry)
7726 CALL dbcsr_create(m_theta_trial(ispin), &
7727 template=matrix_t_out(ispin), &
7728 matrix_type=dbcsr_type_no_symmetry)
7729
7730 CALL dbcsr_set(step(ispin), 0.0_dp)
7731 CALL dbcsr_set(prev_step(ispin), 0.0_dp)
7732
7733 CALL dbcsr_get_info(almo_scf_env%matrix_sigma_inv(ispin), &
7734 nfullrows_total=nocc(ispin))
7735
7736 ! invert S domains if necessary
7737 ! Note: domains for alpha and beta electrons might be different
7738 ! that is why the inversion of the AO overlap is inside the spin loop
7739 IF (my_special_case == xalmo_case_normal) THEN
7740
7741 CALL construct_domain_s_inv( &
7742 matrix_s=almo_scf_env%matrix_s(1), &
7743 subm_s_inv=almo_scf_env%domain_s_inv(:, ispin), &
7744 dpattern=quench_t(ispin), &
7745 map=almo_scf_env%domain_map(ispin), &
7746 node_of_domain=almo_scf_env%cpu_of_domain)
7747
7748 END IF
7749
7750 END DO ! ispin
7751
7752 ! invert metric for special case where metric is spin independent
7753 IF (my_special_case == xalmo_case_block_diag) THEN
7754
7755 CALL dbcsr_create(m_s_inv, &
7756 template=almo_scf_env%matrix_s(1), &
7757 matrix_type=dbcsr_type_no_symmetry)
7758 CALL invert_hotelling(m_s_inv, &
7759 almo_scf_env%matrix_s_blk(1), &
7760 threshold=almo_scf_env%eps_filter, &
7761 filter_eps=almo_scf_env%eps_filter)
7762
7763 ELSE IF (my_special_case == xalmo_case_fully_deloc) THEN
7764
7765 ! invert S using cholesky
7766 CALL dbcsr_create(m_s_inv, &
7767 template=almo_scf_env%matrix_s(1), &
7768 matrix_type=dbcsr_type_no_symmetry)
7769 CALL dbcsr_desymmetrize(almo_scf_env%matrix_s(1), m_s_inv)
7770 CALL cp_dbcsr_cholesky_decompose(m_s_inv, &
7771 para_env=almo_scf_env%para_env, &
7772 blacs_env=almo_scf_env%blacs_env)
7773 CALL cp_dbcsr_cholesky_invert(m_s_inv, &
7774 para_env=almo_scf_env%para_env, &
7775 blacs_env=almo_scf_env%blacs_env, &
7776 uplo_to_full=.true.)
7777 CALL dbcsr_filter(m_s_inv, almo_scf_env%eps_filter)
7778
7779 END IF ! s_inv
7780
7781 radius_max = optimizer%max_trust_radius
7782 radius_current = min(optimizer%initial_trust_radius, radius_max)
7783 ! eta must be between 0 and 0.25
7784 eta = min(max(optimizer%rho_do_not_update, 0.0_dp), 0.25_dp)
7785 energy_start = 0.0_dp
7786 energy_trial = 0.0_dp
7787 penalty_start = 0.0_dp
7788 penalty_trial = 0.0_dp
7789 loss_start = 0.0_dp ! sum of the energy and penalty
7790 loss_trial = 0.0_dp
7791
7792 same_position = .false.
7793
7794 ! compute the energy
7795 CALL main_var_to_xalmos_and_loss_func( &
7796 almo_scf_env=almo_scf_env, &
7797 qs_env=qs_env, &
7798 m_main_var_in=m_theta, &
7799 m_t_out=matrix_t_out, &
7800 m_sig_sqrti_ii_out=m_sig_sqrti_ii, &
7801 energy_out=energy_start, &
7802 penalty_out=penalty_start, &
7803 m_ftsiginv_out=ftsiginv, &
7804 m_siginvtftsiginv_out=siginvtftsiginv, &
7805 m_st_out=st, &
7806 m_stsiginv0_in=stsiginv_0, &
7807 m_quench_t_in=quench_t, &
7808 domain_r_down_in=domain_r_down, &
7809 assume_t0_q0x=assume_t0_q0x, &
7810 just_started=.true., &
7811 optimize_theta=optimize_theta, &
7812 normalize_orbitals=normalize_orbitals, &
7813 perturbation_only=perturbation_only, &
7814 do_penalty=penalty_occ_vol, &
7815 special_case=my_special_case)
7816 loss_start = energy_start + penalty_start
7817 IF (my_special_case == xalmo_case_block_diag) THEN
7818 almo_scf_env%almo_scf_energy = energy_start
7819 END IF
7820 DO ispin = 1, nspins
7821 IF (penalty_occ_vol) THEN
7822 penalty_occ_vol_g_prefactor(ispin) = &
7823 -2.0_dp*penalty_amplitude*spin_factor*nocc(ispin)
7824 penalty_occ_vol_h_prefactor(ispin) = 0.0_dp
7825 END IF
7826 END DO ! ispin
7827
7828 ! start the outer step-size-adjustment loop
7829 scf_converged = .false.
7830 adjust_r_loop: DO outer_iteration = 1, optimizer%max_iter_outer_loop
7831
7832 ! start the inner fixed-radius loop
7833 border_reached = .false.
7834
7835 DO ispin = 1, nspins
7836 CALL dbcsr_set(step(ispin), 0.0_dp)
7837 CALL dbcsr_filter(step(ispin), almo_scf_env%eps_filter)
7838 END DO
7839
7840 IF (.NOT. same_position) THEN
7841
7842 DO ispin = 1, nspins
7843
7844 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Compute model gradient"
7845 CALL compute_gradient( &
7846 m_grad_out=grad(ispin), &
7847 m_ks=almo_scf_env%matrix_ks(ispin), &
7848 m_s=almo_scf_env%matrix_s(1), &
7849 m_t=matrix_t_out(ispin), &
7850 m_t0=almo_scf_env%matrix_t_blk(ispin), &
7851 m_siginv=almo_scf_env%matrix_sigma_inv(ispin), &
7852 m_quench_t=quench_t(ispin), &
7853 m_ftsiginv=ftsiginv(ispin), &
7854 m_siginvtftsiginv=siginvtftsiginv(ispin), &
7855 m_st=st(ispin), &
7856 m_stsiginv0=stsiginv_0(ispin), &
7857 m_theta=m_theta(ispin), &
7858 m_sig_sqrti_ii=m_sig_sqrti_ii(ispin), &
7859 domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), &
7860 domain_r_down=domain_r_down(:, ispin), &
7861 cpu_of_domain=almo_scf_env%cpu_of_domain, &
7862 domain_map=almo_scf_env%domain_map(ispin), &
7863 assume_t0_q0x=assume_t0_q0x, &
7864 optimize_theta=optimize_theta, &
7865 normalize_orbitals=normalize_orbitals, &
7866 penalty_occ_vol=penalty_occ_vol, &
7867 penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(ispin), &
7868 envelope_amplitude=almo_scf_env%envelope_amplitude, &
7869 eps_filter=almo_scf_env%eps_filter, &
7870 spin_factor=spin_factor, &
7871 special_case=my_special_case)
7872
7873 END DO ! ispin
7874
7875 END IF ! skip_grad
7876
7877 ! check convergence and other exit criteria
7878 DO ispin = 1, nspins
7879 grad_norm_spin(ispin) = dbcsr_maxabs(grad(ispin))
7880 END DO ! ispin
7881 grad_norm_ref = maxval(grad_norm_spin)
7882
7883 t2outer = m_walltime()
7884 CALL trust_r_report(unit_nr, &
7885 iter_type=1, & ! only some data is important
7886 iteration=outer_iteration, &
7887 loss=loss_start, &
7888 delta_loss=0.0_dp, &
7889 grad_norm=grad_norm_ref, &
7890 predicted_reduction=0.0_dp, &
7891 rho=0.0_dp, &
7892 radius=radius_current, &
7893 new=.NOT. same_position, &
7894 time=t2outer - t1outer)
7895 t1outer = m_walltime()
7896
7897 IF (grad_norm_ref <= optimizer%eps_error) THEN
7898 scf_converged = .true.
7899 border_reached = .false.
7900 expected_reduction = 0.0_dp
7901 IF (.NOT. (optimizer%early_stopping_on .AND. outer_iteration == 1)) THEN
7902 EXIT adjust_r_loop
7903 END IF
7904 ELSE
7905 scf_converged = .false.
7906 END IF
7907
7908 DO ispin = 1, nspins
7909
7910 CALL dbcsr_copy(m_model_r(ispin), grad(ispin))
7911 CALL dbcsr_scale(m_model_r(ispin), -1.0_dp)
7912
7913 IF (my_special_case == xalmo_case_block_diag .OR. &
7914 my_special_case == xalmo_case_fully_deloc) THEN
7915
7916 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Multiply Sinv.r"
7917 CALL dbcsr_multiply("N", "N", 1.0_dp, &
7918 m_s_inv, &
7919 m_model_r(ispin), &
7920 0.0_dp, m_model_rt(ispin), &
7921 filter_eps=almo_scf_env%eps_filter)
7922
7923 ELSE IF (my_special_case == xalmo_case_normal) THEN
7924
7925 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Multiply Sinv_xx.r"
7926 CALL apply_domain_operators( &
7927 matrix_in=m_model_r(ispin), &
7928 matrix_out=m_model_rt(ispin), &
7929 operator1=almo_scf_env%domain_s_inv(:, ispin), &
7930 dpattern=quench_t(ispin), &
7931 map=almo_scf_env%domain_map(ispin), &
7932 node_of_domain=almo_scf_env%cpu_of_domain, &
7933 my_action=0, &
7934 filter_eps=almo_scf_env%eps_filter)
7935
7936 ELSE
7937 cpabort("Unknown XALMO special case")
7938 END IF
7939
7940 CALL dbcsr_copy(m_model_d(ispin), m_model_rt(ispin))
7941
7942 END DO ! ispin
7943
7944 ! compute model Hessian
7945 IF (.NOT. same_position) THEN
7946
7947 SELECT CASE (prec_type)
7948 CASE (xalmo_prec_domain)
7949
7950 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Compute model Hessian"
7951 DO ispin = 1, nspins
7952 CALL compute_preconditioner( &
7953 domain_prec_out=almo_scf_env%domain_preconditioner(:, ispin), &
7954 m_prec_out=m_model_hessian(ispin), &
7955 m_ks=almo_scf_env%matrix_ks(ispin), &
7956 m_s=almo_scf_env%matrix_s(1), &
7957 m_siginv=almo_scf_env%matrix_sigma_inv(ispin), &
7958 m_quench_t=quench_t(ispin), &
7959 m_ftsiginv=ftsiginv(ispin), &
7960 m_siginvtftsiginv=siginvtftsiginv(ispin), &
7961 m_st=st(ispin), &
7962 para_env=almo_scf_env%para_env, &
7963 blacs_env=almo_scf_env%blacs_env, &
7964 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), &
7965 domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), &
7966 domain_r_down=domain_r_down(:, ispin), &
7967 cpu_of_domain=almo_scf_env%cpu_of_domain, &
7968 domain_map=almo_scf_env%domain_map(ispin), &
7969 assume_t0_q0x=.false., &
7970 penalty_occ_vol=penalty_occ_vol, &
7971 penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(ispin), &
7972 eps_filter=almo_scf_env%eps_filter, &
7973 neg_thr=0.5_dp, &
7974 spin_factor=spin_factor, &
7975 skip_inversion=.true., &
7976 special_case=my_special_case)
7977 END DO ! ispin
7978
7979 CASE DEFAULT
7980
7981 cpabort("Unknown preconditioner")
7982
7983 END SELECT ! preconditioner type fork
7984
7985 END IF ! not same position
7986
7987 ! print the header (argument values are ignored)
7988 CALL fixed_r_report(unit_nr, &
7989 iter_type=0, &
7990 iteration=0, &
7991 step_size=0.0_dp, &
7992 border_reached=.false., &
7993 curvature=0.0_dp, &
7994 grad_norm_ratio=0.0_dp, &
7995 time=0.0_dp)
7996
7997 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Start inner loop"
7998
7999 t1 = m_walltime()
8000 inner_loop_success = .false.
8001 ! trustr_steihaug, trustr_cauchy, trustr_dogleg
8002 fixed_r_loop: DO iteration = 1, optimizer%max_iter
8003
8004 ! Step 2. Get curvature. If negative, step to the border
8005 y_scalar = 0.0_dp
8006 DO ispin = 1, nspins
8007
8008 ! Get B.d
8009 IF (my_special_case == xalmo_case_block_diag .OR. &
8010 my_special_case == xalmo_case_fully_deloc) THEN
8011
8012 CALL dbcsr_multiply("N", "N", 1.0_dp, &
8013 m_model_hessian(ispin), &
8014 m_model_d(ispin), &
8015 0.0_dp, m_model_bd(ispin), &
8016 filter_eps=almo_scf_env%eps_filter)
8017
8018 ELSE
8019
8020 CALL apply_domain_operators( &
8021 matrix_in=m_model_d(ispin), &
8022 matrix_out=m_model_bd(ispin), &
8023 operator1=almo_scf_env%domain_preconditioner(:, ispin), &
8024 dpattern=quench_t(ispin), &
8025 map=almo_scf_env%domain_map(ispin), &
8026 node_of_domain=almo_scf_env%cpu_of_domain, &
8027 my_action=0, &
8028 filter_eps=almo_scf_env%eps_filter)
8029
8030 END IF ! special case
8031
8032 ! Get y=d^T.B.d
8033 CALL dbcsr_dot(m_model_d(ispin), m_model_bd(ispin), real_temp)
8034 y_scalar = y_scalar + real_temp
8035
8036 END DO ! ispin
8037 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Curvature: ", y_scalar
8038
8039 ! step to the border
8040 IF (y_scalar < 0.0_dp) THEN
8041
8042 CALL step_size_to_border( &
8043 step_size_out=step_size, &
8044 metric_in=almo_scf_env%matrix_s, &
8045 position_in=step, &
8046 direction_in=m_model_d, &
8047 trust_radius_in=radius_current, &
8048 quench_t_in=quench_t, &
8049 eps_filter_in=almo_scf_env%eps_filter &
8050 )
8051
8052 DO ispin = 1, nspins
8053 CALL dbcsr_add(step(ispin), m_model_d(ispin), 1.0_dp, step_size)
8054 END DO
8055
8056 border_reached = .true.
8057 inner_loop_success = .true.
8058
8059 CALL predicted_reduction( &
8060 reduction_out=expected_reduction, &
8061 grad_in=grad, &
8062 step_in=step, &
8063 hess_in=m_model_hessian, &
8064 hess_submatrix_in=almo_scf_env%domain_preconditioner, &
8065 quench_t_in=quench_t, &
8066 special_case=my_special_case, &
8067 eps_filter=almo_scf_env%eps_filter, &
8068 domain_map=almo_scf_env%domain_map, &
8069 cpu_of_domain=almo_scf_env%cpu_of_domain &
8070 )
8071
8072 t2 = m_walltime()
8073 CALL fixed_r_report(unit_nr, &
8074 iter_type=2, &
8075 iteration=iteration, &
8076 step_size=step_size, &
8077 border_reached=border_reached, &
8078 curvature=y_scalar, &
8079 grad_norm_ratio=expected_reduction, &
8080 time=t2 - t1)
8081
8082 EXIT fixed_r_loop ! the inner loop
8083
8084 END IF ! y is negative
8085
8086 ! Step 3. Compute the step size along the direction
8087 step_size = 0.0_dp
8088 DO ispin = 1, nspins
8089 CALL dbcsr_dot(m_model_r(ispin), m_model_rt(ispin), real_temp)
8090 step_size = step_size + real_temp
8091 END DO ! ispin
8092 step_size = step_size/y_scalar
8093 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Proposed step size: ", step_size
8094
8095 ! Update the step matrix
8096 DO ispin = 1, nspins
8097 CALL dbcsr_copy(prev_step(ispin), step(ispin))
8098 CALL dbcsr_add(step(ispin), m_model_d(ispin), 1.0_dp, step_size)
8099 END DO
8100
8101 ! Compute step norm
8102 CALL contravariant_matrix_norm( &
8103 norm_out=step_norm, &
8104 matrix_in=step, &
8105 metric_in=almo_scf_env%matrix_s, &
8106 quench_t_in=quench_t, &
8107 eps_filter_in=almo_scf_env%eps_filter &
8108 )
8109 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Step norm: ", step_norm
8110
8111 ! Do not step beyond the trust radius
8112 IF (step_norm > radius_current) THEN
8113
8114 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Norm is too large"
8115 CALL step_size_to_border( &
8116 step_size_out=step_size, &
8117 metric_in=almo_scf_env%matrix_s, &
8118 position_in=prev_step, &
8119 direction_in=m_model_d, &
8120 trust_radius_in=radius_current, &
8121 quench_t_in=quench_t, &
8122 eps_filter_in=almo_scf_env%eps_filter &
8123 )
8124 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Step size to border: ", step_size
8125
8126 DO ispin = 1, nspins
8127 CALL dbcsr_copy(step(ispin), prev_step(ispin))
8128 CALL dbcsr_add(step(ispin), m_model_d(ispin), 1.0_dp, step_size)
8129 END DO
8130
8131 IF (debug_mode) THEN
8132 ! Compute step norm
8133 IF (unit_nr > 0) WRITE (unit_nr, *) "...Extra norm evaluation"
8134 CALL contravariant_matrix_norm( &
8135 norm_out=step_norm, &
8136 matrix_in=step, &
8137 metric_in=almo_scf_env%matrix_s, &
8138 quench_t_in=quench_t, &
8139 eps_filter_in=almo_scf_env%eps_filter &
8140 )
8141 IF (unit_nr > 0) WRITE (unit_nr, *) "...Step norm: ", step_norm
8142 IF (unit_nr > 0) WRITE (unit_nr, *) "...Current radius: ", radius_current
8143 END IF
8144
8145 border_reached = .true.
8146 inner_loop_success = .true.
8147
8148 CALL predicted_reduction( &
8149 reduction_out=expected_reduction, &
8150 grad_in=grad, &
8151 step_in=step, &
8152 hess_in=m_model_hessian, &
8153 hess_submatrix_in=almo_scf_env%domain_preconditioner, &
8154 quench_t_in=quench_t, &
8155 special_case=my_special_case, &
8156 eps_filter=almo_scf_env%eps_filter, &
8157 domain_map=almo_scf_env%domain_map, &
8158 cpu_of_domain=almo_scf_env%cpu_of_domain &
8159 )
8160
8161 t2 = m_walltime()
8162 CALL fixed_r_report(unit_nr, &
8163 iter_type=3, &
8164 iteration=iteration, &
8165 step_size=step_size, &
8166 border_reached=border_reached, &
8167 curvature=y_scalar, &
8168 grad_norm_ratio=expected_reduction, &
8169 time=t2 - t1)
8170
8171 EXIT fixed_r_loop ! the inner loop
8172
8173 END IF
8174
8175 IF (optimizer%trustr_algorithm == trustr_cauchy) THEN
8176 ! trustr_steihaug, trustr_cauchy, trustr_dogleg
8177
8178 border_reached = .false.
8179 inner_loop_success = .true.
8180
8181 CALL predicted_reduction( &
8182 reduction_out=expected_reduction, &
8183 grad_in=grad, &
8184 step_in=step, &
8185 hess_in=m_model_hessian, &
8186 hess_submatrix_in=almo_scf_env%domain_preconditioner, &
8187 quench_t_in=quench_t, &
8188 special_case=my_special_case, &
8189 eps_filter=almo_scf_env%eps_filter, &
8190 domain_map=almo_scf_env%domain_map, &
8191 cpu_of_domain=almo_scf_env%cpu_of_domain &
8192 )
8193
8194 t2 = m_walltime()
8195 CALL fixed_r_report(unit_nr, &
8196 iter_type=5, & ! Cauchy point
8197 iteration=iteration, &
8198 step_size=step_size, &
8199 border_reached=border_reached, &
8200 curvature=y_scalar, &
8201 grad_norm_ratio=expected_reduction, &
8202 time=t2 - t1)
8203
8204 EXIT fixed_r_loop ! the inner loop
8205
8206 ELSE IF (optimizer%trustr_algorithm == trustr_dogleg) THEN
8207
8208 ! invert or pseudo-invert B
8209 SELECT CASE (prec_type)
8210 CASE (xalmo_prec_domain)
8211
8212 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Pseudo-invert model Hessian"
8213 IF (special_case == xalmo_case_block_diag) THEN ! non-overlapping diagonal blocks
8214
8215 DO ispin = 1, nspins
8216 CALL pseudo_invert_diagonal_blk( &
8217 matrix_in=m_model_hessian(ispin), &
8218 matrix_out=m_model_hessian_inv(ispin), &
8219 nocc=almo_scf_env%nocc_of_domain(:, ispin) &
8220 )
8221 END DO
8222
8223 ELSE IF (special_case == xalmo_case_fully_deloc) THEN ! the entire system is a block
8224
8225 ! invert using cholesky decomposition
8226 DO ispin = 1, nspins
8227 CALL dbcsr_copy(m_model_hessian_inv(ispin), &
8228 m_model_hessian(ispin))
8229 CALL cp_dbcsr_cholesky_decompose(m_model_hessian_inv(ispin), &
8230 para_env=almo_scf_env%para_env, &
8231 blacs_env=almo_scf_env%blacs_env)
8232 CALL cp_dbcsr_cholesky_invert(m_model_hessian_inv(ispin), &
8233 para_env=almo_scf_env%para_env, &
8234 blacs_env=almo_scf_env%blacs_env, &
8235 uplo_to_full=.true.)
8236 CALL dbcsr_filter(m_model_hessian_inv(ispin), &
8237 almo_scf_env%eps_filter)
8238 END DO
8239
8240 ELSE
8241
8242 DO ispin = 1, nspins
8243 CALL construct_domain_preconditioner( &
8244 matrix_main=m_model_hessian(ispin), &
8245 subm_s_inv=almo_scf_env%domain_s_inv(:, ispin), &
8246 subm_r_down=domain_r_down(:, ispin), &
8247 matrix_trimmer=quench_t(ispin), &
8248 dpattern=quench_t(ispin), &
8249 map=almo_scf_env%domain_map(ispin), &
8250 node_of_domain=almo_scf_env%cpu_of_domain, &
8251 preconditioner=domain_model_hessian_inv(:, ispin), &
8252 use_trimmer=.false., &
8253 my_action=0, & ! do not do domain (1-r0) projection
8254 skip_inversion=.false. &
8255 )
8256 END DO
8257
8258 END IF ! special_case
8259
8260 CASE DEFAULT
8261
8262 cpabort("Unknown preconditioner")
8263
8264 END SELECT ! preconditioner type fork
8265
8266 ! get pB = Binv.m_model_r = -Binv.grad
8267 DO ispin = 1, nspins
8268
8269 ! Get B.d
8270 IF (my_special_case == xalmo_case_block_diag .OR. &
8271 my_special_case == xalmo_case_fully_deloc) THEN
8272
8273 CALL dbcsr_multiply("N", "N", 1.0_dp, &
8274 m_model_hessian_inv(ispin), &
8275 m_model_r(ispin), &
8276 0.0_dp, m_model_bd(ispin), &
8277 filter_eps=almo_scf_env%eps_filter)
8278
8279 ELSE
8280
8281 CALL apply_domain_operators( &
8282 matrix_in=m_model_r(ispin), &
8283 matrix_out=m_model_bd(ispin), &
8284 operator1=domain_model_hessian_inv(:, ispin), &
8285 dpattern=quench_t(ispin), &
8286 map=almo_scf_env%domain_map(ispin), &
8287 node_of_domain=almo_scf_env%cpu_of_domain, &
8288 my_action=0, &
8289 filter_eps=almo_scf_env%eps_filter)
8290
8291 END IF ! special case
8292
8293 END DO ! ispin
8294
8295 ! Compute norm of pB
8296 CALL contravariant_matrix_norm( &
8297 norm_out=step_norm, &
8298 matrix_in=m_model_bd, &
8299 metric_in=almo_scf_env%matrix_s, &
8300 quench_t_in=quench_t, &
8301 eps_filter_in=almo_scf_env%eps_filter &
8302 )
8303 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...pB norm: ", step_norm
8304
8305 ! Do not step beyond the trust radius
8306 IF (step_norm <= radius_current) THEN
8307
8308 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Full dogleg"
8309
8310 border_reached = .false.
8311
8312 DO ispin = 1, nspins
8313 CALL dbcsr_copy(step(ispin), m_model_bd(ispin))
8314 END DO
8315
8316 fake_step_size_to_report = 2.0_dp
8317 iteration_type_to_report = 6
8318
8319 ELSE ! take a shorter dogleg step
8320
8321 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...pB norm is too large"
8322
8323 border_reached = .true.
8324
8325 ! compute the dogleg vector = pB - pU
8326 ! this destroys -Binv.grad content
8327 DO ispin = 1, nspins
8328 CALL dbcsr_add(m_model_bd(ispin), step(ispin), 1.0_dp, -1.0_dp)
8329 END DO
8330
8331 CALL step_size_to_border( &
8332 step_size_out=step_size, &
8333 metric_in=almo_scf_env%matrix_s, &
8334 position_in=step, &
8335 direction_in=m_model_bd, &
8336 trust_radius_in=radius_current, &
8337 quench_t_in=quench_t, &
8338 eps_filter_in=almo_scf_env%eps_filter &
8339 )
8340 IF (unit_nr > 0 .AND. debug_mode) WRITE (unit_nr, *) "...Step size to border: ", step_size
8341 IF (step_size > 1.0_dp .OR. step_size < 0.0_dp) THEN
8342 IF (unit_nr > 0) THEN
8343 WRITE (unit_nr, *) "Step size (", step_size, ") must lie inside (0,1)"
8344 END IF
8345 cpabort("Wrong dog leg step. We should never end up here.")
8346 END IF
8347
8348 DO ispin = 1, nspins
8349 CALL dbcsr_add(step(ispin), m_model_bd(ispin), 1.0_dp, step_size)
8350 END DO
8351
8352 fake_step_size_to_report = 1.0_dp + step_size
8353 iteration_type_to_report = 7
8354
8355 END IF ! full or partial dogleg?
8356
8357 IF (debug_mode) THEN
8358 ! Compute step norm
8359 IF (unit_nr > 0) WRITE (unit_nr, *) "...Extra norm evaluation"
8360 CALL contravariant_matrix_norm( &
8361 norm_out=step_norm, &
8362 matrix_in=step, &
8363 metric_in=almo_scf_env%matrix_s, &
8364 quench_t_in=quench_t, &
8365 eps_filter_in=almo_scf_env%eps_filter &
8366 )
8367 IF (unit_nr > 0) WRITE (unit_nr, *) "...Step norm: ", step_norm
8368 IF (unit_nr > 0) WRITE (unit_nr, *) "...Current radius: ", radius_current
8369 END IF
8370
8371 CALL predicted_reduction( &
8372 reduction_out=expected_reduction, &
8373 grad_in=grad, &
8374 step_in=step, &
8375 hess_in=m_model_hessian, &
8376 hess_submatrix_in=almo_scf_env%domain_preconditioner, &
8377 quench_t_in=quench_t, &
8378 special_case=my_special_case, &
8379 eps_filter=almo_scf_env%eps_filter, &
8380 domain_map=almo_scf_env%domain_map, &
8381 cpu_of_domain=almo_scf_env%cpu_of_domain &
8382 )
8383
8384 inner_loop_success = .true.
8385
8386 t2 = m_walltime()
8387 CALL fixed_r_report(unit_nr, &
8388 iter_type=iteration_type_to_report, &
8389 iteration=iteration, &
8390 step_size=fake_step_size_to_report, &
8391 border_reached=border_reached, &
8392 curvature=y_scalar, &
8393 grad_norm_ratio=expected_reduction, &
8394 time=t2 - t1)
8395
8396 EXIT fixed_r_loop ! the inner loop
8397
8398 END IF ! Non-iterative subproblem methods exit here
8399
8400 ! Step 4: update model gradient
8401 DO ispin = 1, nspins
8402 ! save previous data
8403 CALL dbcsr_copy(m_model_r_prev(ispin), m_model_r(ispin))
8404 CALL dbcsr_add(m_model_r(ispin), m_model_bd(ispin), &
8405 1.0_dp, -step_size)
8406 END DO ! ispin
8407
8408 ! Model grad norm
8409 DO ispin = 1, nspins
8410 grad_norm_spin(ispin) = dbcsr_maxabs(m_model_r(ispin))
8411 END DO ! ispin
8412 model_grad_norm = maxval(grad_norm_spin)
8413
8414 ! Check norm reduction
8415 grad_norm_ratio = model_grad_norm/grad_norm_ref
8416 IF (grad_norm_ratio < optimizer%model_grad_norm_ratio) THEN
8417
8418 border_reached = .false.
8419 inner_loop_success = .true.
8420
8421 CALL predicted_reduction( &
8422 reduction_out=expected_reduction, &
8423 grad_in=grad, &
8424 step_in=step, &
8425 hess_in=m_model_hessian, &
8426 hess_submatrix_in=almo_scf_env%domain_preconditioner, &
8427 quench_t_in=quench_t, &
8428 special_case=my_special_case, &
8429 eps_filter=almo_scf_env%eps_filter, &
8430 domain_map=almo_scf_env%domain_map, &
8431 cpu_of_domain=almo_scf_env%cpu_of_domain &
8432 )
8433
8434 t2 = m_walltime()
8435 CALL fixed_r_report(unit_nr, &
8436 iter_type=4, &
8437 iteration=iteration, &
8438 step_size=step_size, &
8439 border_reached=border_reached, &
8440 curvature=y_scalar, &
8441 grad_norm_ratio=expected_reduction, &
8442 time=t2 - t1)
8443
8444 EXIT fixed_r_loop ! the inner loop
8445
8446 END IF
8447
8448 ! Step 5: update model direction
8449 DO ispin = 1, nspins
8450 ! save previous data
8451 CALL dbcsr_copy(m_model_rt_prev(ispin), m_model_rt(ispin))
8452 END DO ! ispin
8453
8454 DO ispin = 1, nspins
8455
8456 IF (my_special_case == xalmo_case_block_diag .OR. &
8457 my_special_case == xalmo_case_fully_deloc) THEN
8458
8459 CALL dbcsr_multiply("N", "N", 1.0_dp, &
8460 m_s_inv, &
8461 m_model_r(ispin), &
8462 0.0_dp, m_model_rt(ispin), &
8463 filter_eps=almo_scf_env%eps_filter)
8464
8465 ELSE IF (my_special_case == xalmo_case_normal) THEN
8466
8467 CALL apply_domain_operators( &
8468 matrix_in=m_model_r(ispin), &
8469 matrix_out=m_model_rt(ispin), &
8470 operator1=almo_scf_env%domain_s_inv(:, ispin), &
8471 dpattern=quench_t(ispin), &
8472 map=almo_scf_env%domain_map(ispin), &
8473 node_of_domain=almo_scf_env%cpu_of_domain, &
8474 my_action=0, &
8475 filter_eps=almo_scf_env%eps_filter)
8476
8477 END IF
8478
8479 END DO ! ispin
8480
8481 CALL compute_cg_beta( &
8482 beta=beta, &
8483 reset_conjugator=reset_conjugator, &
8484 conjugator=optimizer%conjugator, &
8485 grad=m_model_r(:), &
8486 prev_grad=m_model_r_prev(:), &
8487 step=m_model_rt(:), &
8488 prev_step=m_model_rt_prev(:) &
8489 )
8490
8491 DO ispin = 1, nspins
8492 ! update direction
8493 CALL dbcsr_add(m_model_d(ispin), m_model_rt(ispin), beta, 1.0_dp)
8494 END DO ! ispin
8495
8496 t2 = m_walltime()
8497 CALL fixed_r_report(unit_nr, &
8498 iter_type=1, &
8499 iteration=iteration, &
8500 step_size=step_size, &
8501 border_reached=border_reached, &
8502 curvature=y_scalar, &
8503 grad_norm_ratio=grad_norm_ratio, &
8504 time=t2 - t1)
8505 t1 = m_walltime()
8506
8507 END DO fixed_r_loop
8508 !!!! done with the inner loop
8509 ! the inner loop must return: step, predicted reduction,
8510 ! whether it reached the border and completed successfully
8511
8512 IF (.NOT. inner_loop_success) THEN
8513 cpabort("Inner loop did not produce solution")
8514 END IF
8515
8516 DO ispin = 1, nspins
8517
8518 CALL dbcsr_copy(m_theta_trial(ispin), m_theta(ispin))
8519 CALL dbcsr_add(m_theta_trial(ispin), step(ispin), 1.0_dp, 1.0_dp)
8520
8521 END DO ! ispin
8522
8523 ! compute the energy
8524 CALL main_var_to_xalmos_and_loss_func( &
8525 almo_scf_env=almo_scf_env, &
8526 qs_env=qs_env, &
8527 m_main_var_in=m_theta_trial, &
8528 m_t_out=matrix_t_out, &
8529 m_sig_sqrti_ii_out=m_sig_sqrti_ii, &
8530 energy_out=energy_trial, &
8531 penalty_out=penalty_trial, &
8532 m_ftsiginv_out=ftsiginv, &
8533 m_siginvtftsiginv_out=siginvtftsiginv, &
8534 m_st_out=st, &
8535 m_stsiginv0_in=stsiginv_0, &
8536 m_quench_t_in=quench_t, &
8537 domain_r_down_in=domain_r_down, &
8538 assume_t0_q0x=assume_t0_q0x, &
8539 just_started=.false., &
8540 optimize_theta=optimize_theta, &
8541 normalize_orbitals=normalize_orbitals, &
8542 perturbation_only=perturbation_only, &
8543 do_penalty=penalty_occ_vol, &
8544 special_case=my_special_case)
8545 loss_trial = energy_trial + penalty_trial
8546
8547 rho = (loss_trial - loss_start)/expected_reduction
8548 loss_change_to_report = loss_trial - loss_start
8549
8550 IF (rho < 0.25_dp) THEN
8551 radius_current = 0.25_dp*radius_current
8552 ELSE
8553 IF (rho > 0.75_dp .AND. border_reached) THEN
8554 radius_current = min(2.0_dp*radius_current, radius_max)
8555 END IF
8556 END IF ! radius adjustment
8557
8558 IF (rho > eta) THEN
8559 DO ispin = 1, nspins
8560 CALL dbcsr_copy(m_theta(ispin), m_theta_trial(ispin))
8561 END DO ! ispin
8562 loss_start = loss_trial
8563 energy_start = energy_trial
8564 penalty_start = penalty_trial
8565 same_position = .false.
8566 IF (my_special_case == xalmo_case_block_diag) THEN
8567 almo_scf_env%almo_scf_energy = energy_trial
8568 END IF
8569 ELSE
8570 same_position = .true.
8571 IF (my_special_case == xalmo_case_block_diag) THEN
8572 almo_scf_env%almo_scf_energy = energy_start
8573 END IF
8574 END IF ! finalize step
8575
8576 t2outer = m_walltime()
8577 CALL trust_r_report(unit_nr, &
8578 iter_type=2, &
8579 iteration=outer_iteration, &
8580 loss=loss_trial, &
8581 delta_loss=loss_change_to_report, &
8582 grad_norm=0.0_dp, &
8583 predicted_reduction=expected_reduction, &
8584 rho=rho, &
8585 radius=radius_current, &
8586 new=.NOT. same_position, &
8587 time=t2outer - t1outer)
8588 t1outer = m_walltime()
8589
8590 END DO adjust_r_loop
8591
8592 ! post SCF-loop calculations
8593 IF (scf_converged) THEN
8594
8595 CALL wrap_up_xalmo_scf( &
8596 qs_env=qs_env, &
8597 almo_scf_env=almo_scf_env, &
8598 perturbation_in=perturbation_only, &
8599 m_xalmo_in=matrix_t_out, &
8600 m_quench_in=quench_t, &
8601 energy_inout=energy_start)
8602
8603 END IF ! if converged
8604
8605 DO ispin = 1, nspins
8606 CALL dbcsr_release(m_model_hessian_inv(ispin))
8607 CALL dbcsr_release(m_model_hessian(ispin))
8608 CALL dbcsr_release(stsiginv_0(ispin))
8609 CALL dbcsr_release(st(ispin))
8610 CALL dbcsr_release(ftsiginv(ispin))
8611 CALL dbcsr_release(siginvtftsiginv(ispin))
8612 CALL dbcsr_release(prev_step(ispin))
8613 CALL dbcsr_release(grad(ispin))
8614 CALL dbcsr_release(step(ispin))
8615 CALL dbcsr_release(m_theta(ispin))
8616 CALL dbcsr_release(m_sig_sqrti_ii(ispin))
8617 CALL dbcsr_release(m_model_r(ispin))
8618 CALL dbcsr_release(m_model_rt(ispin))
8619 CALL dbcsr_release(m_model_d(ispin))
8620 CALL dbcsr_release(m_model_bd(ispin))
8621 CALL dbcsr_release(m_model_r_prev(ispin))
8622 CALL dbcsr_release(m_model_rt_prev(ispin))
8623 CALL dbcsr_release(m_theta_trial(ispin))
8624 CALL release_submatrices(domain_r_down(:, ispin))
8625 CALL release_submatrices(domain_model_hessian_inv(:, ispin))
8626 END DO ! ispin
8627
8628 IF (my_special_case == xalmo_case_block_diag .OR. &
8629 my_special_case == xalmo_case_fully_deloc) THEN
8630 CALL dbcsr_release(m_s_inv)
8631 END IF
8632
8633 DEALLOCATE (m_model_hessian)
8634 DEALLOCATE (m_model_hessian_inv)
8635 DEALLOCATE (siginvtftsiginv)
8636 DEALLOCATE (stsiginv_0)
8637 DEALLOCATE (ftsiginv)
8638 DEALLOCATE (st)
8639 DEALLOCATE (grad)
8640 DEALLOCATE (prev_step)
8641 DEALLOCATE (step)
8642 DEALLOCATE (m_sig_sqrti_ii)
8643 DEALLOCATE (m_model_r)
8644 DEALLOCATE (m_model_rt)
8645 DEALLOCATE (m_model_d)
8646 DEALLOCATE (m_model_bd)
8647 DEALLOCATE (m_model_r_prev)
8648 DEALLOCATE (m_model_rt_prev)
8649 DEALLOCATE (m_theta_trial)
8650
8651 DEALLOCATE (domain_r_down)
8652 DEALLOCATE (domain_model_hessian_inv)
8653
8654 DEALLOCATE (penalty_occ_vol_g_prefactor)
8655 DEALLOCATE (penalty_occ_vol_h_prefactor)
8656 DEALLOCATE (grad_norm_spin)
8657 DEALLOCATE (nocc)
8658
8659 DEALLOCATE (m_theta)
8660
8661 IF (.NOT. scf_converged .AND. .NOT. optimizer%early_stopping_on) THEN
8662 cpabort("Optimization not converged! ")
8663 END IF
8664
8665 CALL timestop(handle)
8666
8667 END SUBROUTINE almo_scf_xalmo_trustr
8668
8669! **************************************************************************************************
8670!> \brief Computes molecular orbitals and the objective (loss) function from the main variables
8671!> Most important input and output variables are given as arguments explicitly.
8672!> Some variables inside almo_scf_env (KS, DM) and qs_env are also updated but are not
8673!> listed as arguments for brevity
8674!> \param almo_scf_env ...
8675!> \param qs_env ...
8676!> \param m_main_var_in ...
8677!> \param m_t_out ...
8678!> \param energy_out ...
8679!> \param penalty_out ...
8680!> \param m_sig_sqrti_ii_out ...
8681!> \param m_FTsiginv_out ...
8682!> \param m_siginvTFTsiginv_out ...
8683!> \param m_ST_out ...
8684!> \param m_STsiginv0_in ...
8685!> \param m_quench_t_in ...
8686!> \param domain_r_down_in ...
8687!> \param assume_t0_q0x ...
8688!> \param just_started ...
8689!> \param optimize_theta ...
8690!> \param normalize_orbitals ...
8691!> \param perturbation_only ...
8692!> \param do_penalty ...
8693!> \param special_case ...
8694!> \par History
8695!> 2019.12 created [Rustam Z Khaliullin]
8696!> \author Rustam Z Khaliullin
8697! **************************************************************************************************
8698 SUBROUTINE main_var_to_xalmos_and_loss_func(almo_scf_env, qs_env, m_main_var_in, &
8699 m_t_out, energy_out, penalty_out, m_sig_sqrti_ii_out, m_FTsiginv_out, &
8700 m_siginvTFTsiginv_out, m_ST_out, m_STsiginv0_in, m_quench_t_in, domain_r_down_in, &
8701 assume_t0_q0x, just_started, optimize_theta, normalize_orbitals, perturbation_only, &
8702 do_penalty, special_case)
8703
8704 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
8705 TYPE(qs_environment_type), POINTER :: qs_env
8706 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_main_var_in
8707 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_t_out
8708 REAL(kind=dp), INTENT(OUT) :: energy_out, penalty_out
8709 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_sig_sqrti_ii_out, m_ftsiginv_out, &
8710 m_siginvtftsiginv_out, m_st_out, &
8711 m_stsiginv0_in, m_quench_t_in
8712 TYPE(domain_submatrix_type), DIMENSION(:, :), &
8713 INTENT(IN) :: domain_r_down_in
8714 LOGICAL, INTENT(IN) :: assume_t0_q0x, just_started, &
8715 optimize_theta, normalize_orbitals, &
8716 perturbation_only, do_penalty
8717 INTEGER, INTENT(IN) :: special_case
8718
8719 CHARACTER(len=*), PARAMETER :: routinen = 'main_var_to_xalmos_and_loss_func'
8720
8721 INTEGER :: handle, ispin, nspins
8722 INTEGER, ALLOCATABLE, DIMENSION(:) :: nocc
8723 REAL(kind=dp) :: det1, energy_ispin, penalty_amplitude, &
8724 spin_factor
8725
8726 CALL timeset(routinen, handle)
8727
8728 energy_out = 0.0_dp
8729 penalty_out = 0.0_dp
8730
8731 nspins = SIZE(m_main_var_in)
8732 IF (nspins == 1) THEN
8733 spin_factor = 2.0_dp
8734 ELSE
8735 spin_factor = 1.0_dp
8736 END IF
8737
8738 penalty_amplitude = 0.0_dp !almo_scf_env%penalty%occ_vol_coeff
8739
8740 ALLOCATE (nocc(nspins))
8741 DO ispin = 1, nspins
8742 CALL dbcsr_get_info(almo_scf_env%matrix_sigma_inv(ispin), &
8743 nfullrows_total=nocc(ispin))
8744 END DO
8745
8746 DO ispin = 1, nspins
8747
8748 ! compute MO coefficients from the main variable
8749 CALL compute_xalmos_from_main_var( &
8750 m_var_in=m_main_var_in(ispin), &
8751 m_t_out=m_t_out(ispin), &
8752 m_quench_t=m_quench_t_in(ispin), &
8753 m_t0=almo_scf_env%matrix_t_blk(ispin), &
8754 m_oo_template=almo_scf_env%matrix_sigma_inv(ispin), &
8755 m_stsiginv0=m_stsiginv0_in(ispin), &
8756 m_s=almo_scf_env%matrix_s(1), &
8757 m_sig_sqrti_ii_out=m_sig_sqrti_ii_out(ispin), &
8758 domain_r_down=domain_r_down_in(:, ispin), &
8759 domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), &
8760 domain_map=almo_scf_env%domain_map(ispin), &
8761 cpu_of_domain=almo_scf_env%cpu_of_domain, &
8762 assume_t0_q0x=assume_t0_q0x, &
8763 just_started=just_started, &
8764 optimize_theta=optimize_theta, &
8765 normalize_orbitals=normalize_orbitals, &
8766 envelope_amplitude=almo_scf_env%envelope_amplitude, &
8767 eps_filter=almo_scf_env%eps_filter, &
8768 special_case=special_case, &
8769 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), &
8770 order_lanczos=almo_scf_env%order_lanczos, &
8771 eps_lanczos=almo_scf_env%eps_lanczos, &
8772 max_iter_lanczos=almo_scf_env%max_iter_lanczos)
8773
8774 ! compute the global projectors (for the density matrix)
8775 CALL almo_scf_t_to_proj( &
8776 t=m_t_out(ispin), &
8777 p=almo_scf_env%matrix_p(ispin), &
8778 eps_filter=almo_scf_env%eps_filter, &
8779 orthog_orbs=.false., &
8780 nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), &
8781 s=almo_scf_env%matrix_s(1), &
8782 sigma=almo_scf_env%matrix_sigma(ispin), &
8783 sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), &
8784 use_guess=.false., &
8785 algorithm=almo_scf_env%sigma_inv_algorithm, &
8786 inv_eps_factor=almo_scf_env%matrix_iter_eps_error_factor, &
8787 inverse_accelerator=almo_scf_env%order_lanczos, &
8788 eps_lanczos=almo_scf_env%eps_lanczos, &
8789 max_iter_lanczos=almo_scf_env%max_iter_lanczos, &
8790 para_env=almo_scf_env%para_env, &
8791 blacs_env=almo_scf_env%blacs_env)
8792
8793 ! compute dm from the projector(s)
8794 CALL dbcsr_scale(almo_scf_env%matrix_p(ispin), &
8795 spin_factor)
8796
8797 END DO ! ispin
8798
8799 ! update the KS matrix and energy if necessary
8800 IF (perturbation_only) THEN
8801 ! note: do not combine the two IF statements
8802 IF (just_started) THEN
8803 DO ispin = 1, nspins
8804 CALL dbcsr_copy(almo_scf_env%matrix_ks(ispin), &
8805 almo_scf_env%matrix_ks_0deloc(ispin))
8806 END DO
8807 END IF
8808 ELSE
8809 ! the KS matrix is updated outside the spin loop
8810 CALL almo_dm_to_almo_ks(qs_env, &
8811 almo_scf_env%matrix_p, &
8812 almo_scf_env%matrix_ks, &
8813 energy_out, &
8814 almo_scf_env%eps_filter, &
8815 almo_scf_env%mat_distr_aos)
8816 END IF
8817
8818 penalty_out = 0.0_dp
8819 DO ispin = 1, nspins
8820
8821 CALL compute_frequently_used_matrices( &
8822 filter_eps=almo_scf_env%eps_filter, &
8823 m_t_in=m_t_out(ispin), &
8824 m_siginv_in=almo_scf_env%matrix_sigma_inv(ispin), &
8825 m_s_in=almo_scf_env%matrix_s(1), &
8826 m_f_in=almo_scf_env%matrix_ks(ispin), &
8827 m_ftsiginv_out=m_ftsiginv_out(ispin), &
8828 m_siginvtftsiginv_out=m_siginvtftsiginv_out(ispin), &
8829 m_st_out=m_st_out(ispin))
8830
8831 IF (perturbation_only) THEN
8832 ! calculate objective function Tr(F_0 R)
8833 IF (ispin == 1) energy_out = 0.0_dp
8834 CALL dbcsr_dot(m_t_out(ispin), m_ftsiginv_out(ispin), energy_ispin)
8835 energy_out = energy_out + energy_ispin*spin_factor
8836 END IF
8837
8838 IF (do_penalty) THEN
8839
8840 CALL determinant(almo_scf_env%matrix_sigma(ispin), det1, &
8841 almo_scf_env%eps_filter)
8842 penalty_out = penalty_out - &
8843 penalty_amplitude*spin_factor*nocc(ispin)*log(det1)
8844
8845 END IF
8846
8847 END DO ! ispin
8848
8849 DEALLOCATE (nocc)
8850
8851 CALL timestop(handle)
8852
8853 END SUBROUTINE main_var_to_xalmos_and_loss_func
8854
8855! **************************************************************************************************
8856!> \brief Computes the step size required to reach the trust-radius border,
8857!> measured from the origin,
8858!> given the current position (position) in the direction (direction)
8859!> \param step_size_out ...
8860!> \param metric_in ...
8861!> \param position_in ...
8862!> \param direction_in ...
8863!> \param trust_radius_in ...
8864!> \param quench_t_in ...
8865!> \param eps_filter_in ...
8866!> \par History
8867!> 2019.12 created [Rustam Z Khaliullin]
8868!> \author Rustam Z Khaliullin
8869! **************************************************************************************************
8870 SUBROUTINE step_size_to_border(step_size_out, metric_in, position_in, &
8871 direction_in, trust_radius_in, quench_t_in, eps_filter_in)
8872
8873 REAL(kind=dp), INTENT(INOUT) :: step_size_out
8874 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: metric_in, position_in, direction_in
8875 REAL(kind=dp), INTENT(IN) :: trust_radius_in
8876 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: quench_t_in
8877 REAL(kind=dp), INTENT(IN) :: eps_filter_in
8878
8879 INTEGER :: isol, ispin, nsolutions, &
8880 nsolutions_found, nspins
8881 INTEGER, ALLOCATABLE, DIMENSION(:) :: nocc
8882 REAL(kind=dp) :: discrim_sign, discriminant, solution, &
8883 spin_factor, temp_real
8884 REAL(kind=dp), DIMENSION(3) :: coef
8885 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: m_temp_no
8886
8887 step_size_out = 0.0_dp
8888
8889 nspins = SIZE(position_in)
8890 IF (nspins == 1) THEN
8891 spin_factor = 2.0_dp
8892 ELSE
8893 spin_factor = 1.0_dp
8894 END IF
8895
8896 ALLOCATE (nocc(nspins))
8897 ALLOCATE (m_temp_no(nspins))
8898
8899 coef(:) = 0.0_dp
8900 DO ispin = 1, nspins
8901
8902 CALL dbcsr_create(m_temp_no(ispin), &
8903 template=direction_in(ispin))
8904
8905 CALL dbcsr_get_info(direction_in(ispin), &
8906 nfullcols_total=nocc(ispin))
8907
8908 CALL dbcsr_copy(m_temp_no(ispin), quench_t_in(ispin))
8909 CALL dbcsr_multiply("N", "N", 1.0_dp, &
8910 metric_in(1), &
8911 position_in(ispin), &
8912 0.0_dp, m_temp_no(ispin), &
8913 retain_sparsity=.true.)
8914 CALL dbcsr_filter(m_temp_no(ispin), eps_filter_in)
8915 CALL dbcsr_dot(position_in(ispin), m_temp_no(ispin), temp_real)
8916 coef(3) = coef(3) + temp_real/nocc(ispin)
8917 CALL dbcsr_dot(direction_in(ispin), m_temp_no(ispin), temp_real)
8918 coef(2) = coef(2) + 2.0_dp*temp_real/nocc(ispin)
8919 CALL dbcsr_copy(m_temp_no(ispin), quench_t_in(ispin))
8920 CALL dbcsr_multiply("N", "N", 1.0_dp, &
8921 metric_in(1), &
8922 direction_in(ispin), &
8923 0.0_dp, m_temp_no(ispin), &
8924 retain_sparsity=.true.)
8925 CALL dbcsr_filter(m_temp_no(ispin), eps_filter_in)
8926 CALL dbcsr_dot(direction_in(ispin), m_temp_no(ispin), temp_real)
8927 coef(1) = coef(1) + temp_real/nocc(ispin)
8928
8929 CALL dbcsr_release(m_temp_no(ispin))
8930
8931 END DO !ispin
8932
8933 DEALLOCATE (nocc)
8934 DEALLOCATE (m_temp_no)
8935
8936 coef(:) = coef(:)*spin_factor
8937 coef(3) = coef(3) - trust_radius_in*trust_radius_in
8938
8939 ! solve the quadratic equation
8940 discriminant = coef(2)*coef(2) - 4.0_dp*coef(1)*coef(3)
8941 IF (discriminant > tiny(discriminant)) THEN
8942 nsolutions = 2
8943 ELSE IF (discriminant < 0.0_dp) THEN
8944 nsolutions = 0
8945 cpabort("Step to border: no solutions")
8946 ELSE
8947 nsolutions = 1
8948 END IF
8949
8950 discrim_sign = 1.0_dp
8951 nsolutions_found = 0
8952 DO isol = 1, nsolutions
8953 solution = (-coef(2) + discrim_sign*sqrt(discriminant))/(2.0_dp*coef(1))
8954 IF (solution > 0.0_dp) THEN
8955 nsolutions_found = nsolutions_found + 1
8956 step_size_out = solution
8957 END IF
8958 discrim_sign = -discrim_sign
8959 END DO
8960
8961 IF (nsolutions_found == 0) THEN
8962 cpabort("Step to border: no positive solutions")
8963 ELSE IF (nsolutions_found == 2) THEN
8964 cpabort("Two positive border steps possible!")
8965 END IF
8966
8967 END SUBROUTINE step_size_to_border
8968
8969! **************************************************************************************************
8970!> \brief Computes a norm of a contravariant NBasis x Occ matrix using proper metric
8971!> \param norm_out ...
8972!> \param matrix_in ...
8973!> \param metric_in ...
8974!> \param quench_t_in ...
8975!> \param eps_filter_in ...
8976!> \par History
8977!> 2019.12 created [Rustam Z Khaliullin]
8978!> \author Rustam Z Khaliullin
8979! **************************************************************************************************
8980 SUBROUTINE contravariant_matrix_norm(norm_out, matrix_in, metric_in, &
8981 quench_t_in, eps_filter_in)
8982
8983 REAL(kind=dp), INTENT(OUT) :: norm_out
8984 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: matrix_in, metric_in, quench_t_in
8985 REAL(kind=dp), INTENT(IN) :: eps_filter_in
8986
8987 INTEGER :: ispin, nspins
8988 INTEGER, ALLOCATABLE, DIMENSION(:) :: nocc
8989 REAL(kind=dp) :: my_norm, spin_factor, temp_real
8990 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: m_temp_no
8991
8992 ! Frist thing: assign the output value to avoid norms being undefined
8993 norm_out = 0.0_dp
8994
8995 nspins = SIZE(matrix_in)
8996 IF (nspins == 1) THEN
8997 spin_factor = 2.0_dp
8998 ELSE
8999 spin_factor = 1.0_dp
9000 END IF
9001
9002 ALLOCATE (nocc(nspins))
9003 ALLOCATE (m_temp_no(nspins))
9004
9005 my_norm = 0.0_dp
9006 DO ispin = 1, nspins
9007
9008 CALL dbcsr_create(m_temp_no(ispin), template=matrix_in(ispin))
9009
9010 CALL dbcsr_get_info(matrix_in(ispin), &
9011 nfullcols_total=nocc(ispin))
9012
9013 CALL dbcsr_copy(m_temp_no(ispin), quench_t_in(ispin))
9014 CALL dbcsr_multiply("N", "N", 1.0_dp, &
9015 metric_in(1), &
9016 matrix_in(ispin), &
9017 0.0_dp, m_temp_no(ispin), &
9018 retain_sparsity=.true.)
9019 CALL dbcsr_filter(m_temp_no(ispin), eps_filter_in)
9020 CALL dbcsr_dot(matrix_in(ispin), m_temp_no(ispin), temp_real)
9021
9022 my_norm = my_norm + temp_real/nocc(ispin)
9023
9024 CALL dbcsr_release(m_temp_no(ispin))
9025
9026 END DO !ispin
9027
9028 DEALLOCATE (nocc)
9029 DEALLOCATE (m_temp_no)
9030
9031 my_norm = my_norm*spin_factor
9032 norm_out = sqrt(my_norm)
9033
9034 END SUBROUTINE contravariant_matrix_norm
9035
9036! **************************************************************************************************
9037!> \brief Loss reduction for a given step is estimated using
9038!> gradient and hessian
9039!> \param reduction_out ...
9040!> \param grad_in ...
9041!> \param step_in ...
9042!> \param hess_in ...
9043!> \param hess_submatrix_in ...
9044!> \param quench_t_in ...
9045!> \param special_case ...
9046!> \param eps_filter ...
9047!> \param domain_map ...
9048!> \param cpu_of_domain ...
9049!> \par History
9050!> 2019.12 created [Rustam Z Khaliullin]
9051!> \author Rustam Z Khaliullin
9052! **************************************************************************************************
9053 SUBROUTINE predicted_reduction(reduction_out, grad_in, step_in, hess_in, &
9054 hess_submatrix_in, quench_t_in, special_case, eps_filter, domain_map, &
9055 cpu_of_domain)
9056
9057 !RZK-noncritical: can be formulated without submatrices
9058 REAL(kind=dp), INTENT(INOUT) :: reduction_out
9059 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: grad_in, step_in, hess_in
9060 TYPE(domain_submatrix_type), DIMENSION(:, :), &
9061 INTENT(IN) :: hess_submatrix_in
9062 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: quench_t_in
9063 INTEGER, INTENT(IN) :: special_case
9064 REAL(kind=dp), INTENT(IN) :: eps_filter
9065 TYPE(domain_map_type), DIMENSION(:), INTENT(IN) :: domain_map
9066 INTEGER, DIMENSION(:), INTENT(IN) :: cpu_of_domain
9067
9068 INTEGER :: ispin, nspins
9069 REAL(kind=dp) :: my_reduction, spin_factor, temp_real
9070 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: m_temp_no
9071
9072 reduction_out = 0.0_dp
9073
9074 nspins = SIZE(grad_in)
9075 IF (nspins == 1) THEN
9076 spin_factor = 2.0_dp
9077 ELSE
9078 spin_factor = 1.0_dp
9079 END IF
9080
9081 ALLOCATE (m_temp_no(nspins))
9082
9083 my_reduction = 0.0_dp
9084 DO ispin = 1, nspins
9085
9086 CALL dbcsr_create(m_temp_no(ispin), template=grad_in(ispin))
9087
9088 CALL dbcsr_dot(step_in(ispin), grad_in(ispin), temp_real)
9089 my_reduction = my_reduction + temp_real
9090
9091 ! Get Hess.step
9092 IF (special_case == xalmo_case_block_diag .OR. &
9093 special_case == xalmo_case_fully_deloc) THEN
9094
9095 CALL dbcsr_multiply("N", "N", 1.0_dp, &
9096 hess_in(ispin), &
9097 step_in(ispin), &
9098 0.0_dp, m_temp_no(ispin), &
9099 filter_eps=eps_filter)
9100
9101 ELSE
9102
9103 CALL apply_domain_operators( &
9104 matrix_in=step_in(ispin), &
9105 matrix_out=m_temp_no(ispin), &
9106 operator1=hess_submatrix_in(:, ispin), &
9107 dpattern=quench_t_in(ispin), &
9108 map=domain_map(ispin), &
9109 node_of_domain=cpu_of_domain, &
9110 my_action=0, &
9111 filter_eps=eps_filter)
9112
9113 END IF ! special case
9114
9115 ! Get y=step^T.Hess.step
9116 CALL dbcsr_dot(step_in(ispin), m_temp_no(ispin), temp_real)
9117 my_reduction = my_reduction + 0.5_dp*temp_real
9118
9119 CALL dbcsr_release(m_temp_no(ispin))
9120
9121 END DO ! ispin
9122
9123 !RZK-critical: do we need to multiply by the spin factor?
9124 my_reduction = spin_factor*my_reduction
9125
9126 reduction_out = my_reduction
9127
9128 DEALLOCATE (m_temp_no)
9129
9130 END SUBROUTINE predicted_reduction
9131
9132! **************************************************************************************************
9133!> \brief Prints key quantities from the fixed-radius minimizer
9134!> \param unit_nr ...
9135!> \param iter_type ...
9136!> \param iteration ...
9137!> \param step_size ...
9138!> \param border_reached ...
9139!> \param curvature ...
9140!> \param grad_norm_ratio ...
9141!> \param predicted_reduction ...
9142!> \param time ...
9143!> \par History
9144!> 2019.12 created [Rustam Z Khaliullin]
9145!> \author Rustam Z Khaliullin
9146! **************************************************************************************************
9147 SUBROUTINE fixed_r_report(unit_nr, iter_type, iteration, step_size, &
9148 border_reached, curvature, grad_norm_ratio, predicted_reduction, time)
9149
9150 INTEGER, INTENT(IN) :: unit_nr, iter_type, iteration
9151 REAL(kind=dp), INTENT(IN) :: step_size
9152 LOGICAL, INTENT(IN) :: border_reached
9153 REAL(kind=dp), INTENT(IN) :: curvature
9154 REAL(kind=dp), INTENT(IN), OPTIONAL :: grad_norm_ratio, predicted_reduction
9155 REAL(kind=dp), INTENT(IN) :: time
9156
9157 CHARACTER(LEN=20) :: iter_type_str
9158 REAL(kind=dp) :: loss_or_grad_change
9159
9160 loss_or_grad_change = 0.0_dp
9161 IF (PRESENT(grad_norm_ratio)) THEN
9162 loss_or_grad_change = grad_norm_ratio
9163 ELSE IF (PRESENT(predicted_reduction)) THEN
9164 loss_or_grad_change = predicted_reduction
9165 ELSE
9166 cpabort("one argument is missing")
9167 END IF
9168
9169 SELECT CASE (iter_type)
9170 CASE (0)
9171 iter_type_str = trim("Ignored")
9172 CASE (1)
9173 iter_type_str = trim("PCG")
9174 CASE (2)
9175 iter_type_str = trim("Neg. curvatr.")
9176 CASE (3)
9177 iter_type_str = trim("Step too long")
9178 CASE (4)
9179 iter_type_str = trim("Grad. reduced")
9180 CASE (5)
9181 iter_type_str = trim("Cauchy point")
9182 CASE (6)
9183 iter_type_str = trim("Full dogleg")
9184 CASE (7)
9185 iter_type_str = trim("Part. dogleg")
9186 CASE DEFAULT
9187 cpabort("unknown report type")
9188 END SELECT
9189
9190 IF (unit_nr > 0) THEN
9191
9192 SELECT CASE (iter_type)
9193 CASE (0)
9194
9195 WRITE (unit_nr, *)
9196 WRITE (unit_nr, '(T4,A15,A6,A10,A10,A7,A20,A8)') &
9197 "Action", &
9198 "Iter", &
9199 "Curv", &
9200 "Step", &
9201 "Edge?", &
9202 "Grad/o.f. reduc", &
9203 "Time"
9204
9205 CASE DEFAULT
9206
9207 WRITE (unit_nr, '(T4,A15,I6,F10.5,F10.5,L7,F20.10,F8.2)') &
9208 iter_type_str, &
9209 iteration, &
9210 curvature, step_size, border_reached, &
9211 loss_or_grad_change, &
9212 time
9213
9214 END SELECT
9215
9216 ! epilogue
9217 SELECT CASE (iter_type)
9218 CASE (2, 3, 4, 5, 6, 7)
9219
9220 WRITE (unit_nr, *)
9221
9222 END SELECT
9223
9224 END IF
9225
9226 END SUBROUTINE fixed_r_report
9227
9228! **************************************************************************************************
9229!> \brief Prints key quantities from the loop that tunes trust radius
9230!> \param unit_nr ...
9231!> \param iter_type ...
9232!> \param iteration ...
9233!> \param radius ...
9234!> \param loss ...
9235!> \param delta_loss ...
9236!> \param grad_norm ...
9237!> \param predicted_reduction ...
9238!> \param rho ...
9239!> \param new ...
9240!> \param time ...
9241!> \par History
9242!> 2019.12 created [Rustam Z Khaliullin]
9243!> \author Rustam Z Khaliullin
9244! **************************************************************************************************
9245 SUBROUTINE trust_r_report(unit_nr, iter_type, iteration, radius, &
9246 loss, delta_loss, grad_norm, predicted_reduction, rho, new, time)
9247
9248 INTEGER, INTENT(IN) :: unit_nr, iter_type, iteration
9249 REAL(kind=dp), INTENT(IN) :: radius, loss, delta_loss, grad_norm, &
9250 predicted_reduction, rho
9251 LOGICAL, INTENT(IN) :: new
9252 REAL(kind=dp), INTENT(IN) :: time
9253
9254 CHARACTER(LEN=20) :: iter_status, iter_type_str
9255
9256 SELECT CASE (iter_type)
9257 CASE (0) ! header
9258 iter_type_str = trim("Iter")
9259 iter_status = trim("Stat")
9260 CASE (1) ! first iteration, not all data is available yet
9261 iter_type_str = trim("TR INI")
9262 IF (new) THEN
9263 iter_status = " New" ! new point
9264 ELSE
9265 iter_status = " Redo" ! restarted
9266 END IF
9267 CASE (2) ! typical
9268 iter_type_str = trim("TR FIN")
9269 IF (new) THEN
9270 iter_status = " Acc" ! accepted
9271 ELSE
9272 iter_status = " Rej" ! rejected
9273 END IF
9274 CASE DEFAULT
9275 cpabort("unknown report type")
9276 END SELECT
9277
9278 IF (unit_nr > 0) THEN
9279
9280 SELECT CASE (iter_type)
9281 CASE (0)
9282
9283 WRITE (unit_nr, '(T2,A6,A5,A6,A22,A10,T67,A7,A6)') &
9284 "Method", &
9285 "Stat", &
9286 "Iter", &
9287 "Objective Function", &
9288 "Conver", &!"Model Change", "Rho", &
9289 "Radius", &
9290 "Time"
9291 WRITE (unit_nr, '(T41,A10,A10,A6)') &
9292 !"Method", &
9293 !"Iter", &
9294 !"Objective Function", &
9295 "Change", "Expct.", "Rho"
9296 !"Radius", &
9297 !"Time"
9298
9299 CASE (1)
9300
9301 WRITE (unit_nr, '(T2,A6,A5,I6,F22.10,ES10.2,T67,ES7.0,F6.1)') &
9302 iter_type_str, &
9303 iter_status, &
9304 iteration, &
9305 loss, &
9306 grad_norm, & ! distinct
9307 radius, &
9308 time
9309
9310 CASE (2)
9311
9312 WRITE (unit_nr, '(T2,A6,A5,I6,F22.10,ES10.2,ES10.2,F6.1,ES7.0,F6.1)') &
9313 iter_type_str, &
9314 iter_status, &
9315 iteration, &
9316 loss, &
9317 delta_loss, predicted_reduction, rho, & ! distinct
9318 radius, &
9319 time
9320
9321 END SELECT
9322 END IF
9323
9324 END SUBROUTINE trust_r_report
9325
9326! **************************************************************************************************
9327!> \brief ...
9328!> \param unit_nr ...
9329!> \param ref_energy ...
9330!> \param energy_lowering ...
9331! **************************************************************************************************
9332 SUBROUTINE energy_lowering_report(unit_nr, ref_energy, energy_lowering)
9333
9334 INTEGER, INTENT(IN) :: unit_nr
9335 REAL(kind=dp), INTENT(IN) :: ref_energy, energy_lowering
9336
9337 ! print out the energy lowering
9338 IF (unit_nr > 0) THEN
9339 WRITE (unit_nr, *)
9340 WRITE (unit_nr, '(T2,A35,F25.10)') "ENERGY OF BLOCK-DIAGONAL ALMOs:", &
9341 ref_energy
9342 WRITE (unit_nr, '(T2,A35,F25.10)') "ENERGY LOWERING:", &
9343 energy_lowering
9344 WRITE (unit_nr, '(T2,A35,F25.10)') "CORRECTED ENERGY:", &
9345 ref_energy + energy_lowering
9346 WRITE (unit_nr, *)
9347 END IF
9348
9349 END SUBROUTINE energy_lowering_report
9350
9351 ! post SCF-loop calculations
9352! **************************************************************************************************
9353!> \brief ...
9354!> \param qs_env ...
9355!> \param almo_scf_env ...
9356!> \param perturbation_in ...
9357!> \param m_xalmo_in ...
9358!> \param m_quench_in ...
9359!> \param energy_inout ...
9360! **************************************************************************************************
9361 SUBROUTINE wrap_up_xalmo_scf(qs_env, almo_scf_env, perturbation_in, &
9362 m_xalmo_in, m_quench_in, energy_inout)
9363
9364 TYPE(qs_environment_type), POINTER :: qs_env
9365 TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env
9366 LOGICAL, INTENT(IN) :: perturbation_in
9367 TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_xalmo_in, m_quench_in
9368 REAL(kind=dp), INTENT(INOUT) :: energy_inout
9369
9370 CHARACTER(len=*), PARAMETER :: routinen = 'wrap_up_xalmo_scf'
9371
9372 INTEGER :: eda_unit, handle, ispin, nspins, unit_nr
9373 TYPE(cp_logger_type), POINTER :: logger
9374 TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: m_temp_no1, m_temp_no2
9375 TYPE(section_vals_type), POINTER :: almo_print_section, input
9376
9377 CALL timeset(routinen, handle)
9378
9379 ! get a useful output_unit
9380 logger => cp_get_default_logger()
9381 IF (logger%para_env%is_source()) THEN
9382 unit_nr = cp_logger_get_default_unit_nr(logger, local=.true.)
9383 ELSE
9384 unit_nr = -1
9385 END IF
9386
9387 nspins = almo_scf_env%nspins
9388
9389 ! RZK-warning: must obtain MO coefficients from final theta
9390
9391 IF (perturbation_in) THEN
9392
9393 ALLOCATE (m_temp_no1(nspins))
9394 ALLOCATE (m_temp_no2(nspins))
9395
9396 DO ispin = 1, nspins
9397 CALL dbcsr_create(m_temp_no1(ispin), template=m_xalmo_in(ispin))
9398 CALL dbcsr_create(m_temp_no2(ispin), template=m_xalmo_in(ispin))
9399 END DO
9400
9401 ! return perturbed density to qs_env
9402 CALL almo_dm_to_qs_env(qs_env, almo_scf_env%matrix_p, &
9403 almo_scf_env%mat_distr_aos)
9404
9405 ! compute energy correction and perform
9406 ! detailed decomposition analysis (if requested)
9407 ! reuse step and grad matrices to store decomposition results
9408 CALL xalmo_analysis( &
9409 detailed_analysis=almo_scf_env%almo_analysis%do_analysis, &
9410 eps_filter=almo_scf_env%eps_filter, &
9411 m_t_in=m_xalmo_in, &
9412 m_t0_in=almo_scf_env%matrix_t_blk, &
9413 m_siginv_in=almo_scf_env%matrix_sigma_inv, &
9414 m_siginv0_in=almo_scf_env%matrix_sigma_inv_0deloc, &
9415 m_s_in=almo_scf_env%matrix_s, &
9416 m_ks0_in=almo_scf_env%matrix_ks_0deloc, &
9417 m_quench_t_in=m_quench_in, &
9418 energy_out=energy_inout, & ! get energy loewring
9419 m_eda_out=m_temp_no1, &
9420 m_cta_out=m_temp_no2 &
9421 )
9422
9423 IF (almo_scf_env%almo_analysis%do_analysis) THEN
9424
9425 DO ispin = 1, nspins
9426
9427 ! energy decomposition analysis (EDA)
9428 IF (unit_nr > 0) THEN
9429 WRITE (unit_nr, '(T2,A)') "DECOMPOSITION OF THE DELOCALIZATION ENERGY"
9430 END IF
9431
9432 ! open the output file, print and close
9433 CALL get_qs_env(qs_env, input=input)
9434 almo_print_section => section_vals_get_subs_vals(input, "DFT%ALMO_SCF%ANALYSIS%PRINT")
9435 eda_unit = cp_print_key_unit_nr(logger, almo_print_section, &
9436 "ALMO_EDA_CT", extension=".dat", local=.true.)
9437 CALL print_block_sum(m_temp_no1(ispin), eda_unit)
9438 CALL cp_print_key_finished_output(eda_unit, logger, almo_print_section, &
9439 "ALMO_EDA_CT", local=.true.)
9440
9441 ! charge transfer analysis (CTA)
9442 IF (unit_nr > 0) THEN
9443 WRITE (unit_nr, '(T2,A)') "DECOMPOSITION OF CHARGE TRANSFER TERMS"
9444 END IF
9445
9446 eda_unit = cp_print_key_unit_nr(logger, almo_print_section, &
9447 "ALMO_CTA", extension=".dat", local=.true.)
9448 CALL print_block_sum(m_temp_no2(ispin), eda_unit)
9449 CALL cp_print_key_finished_output(eda_unit, logger, almo_print_section, &
9450 "ALMO_CTA", local=.true.)
9451
9452 END DO ! ispin
9453
9454 END IF ! do ALMO EDA/CTA
9455
9456 CALL energy_lowering_report( &
9457 unit_nr=unit_nr, &
9458 ref_energy=almo_scf_env%almo_scf_energy, &
9459 energy_lowering=energy_inout)
9460 CALL almo_scf_update_ks_energy(qs_env, &
9461 energy=almo_scf_env%almo_scf_energy, &
9462 energy_singles_corr=energy_inout)
9463
9464 DO ispin = 1, nspins
9465 CALL dbcsr_release(m_temp_no1(ispin))
9466 CALL dbcsr_release(m_temp_no2(ispin))
9467 END DO
9468
9469 DEALLOCATE (m_temp_no1)
9470 DEALLOCATE (m_temp_no2)
9471
9472 ELSE ! non-perturbative
9473
9474 CALL almo_scf_update_ks_energy(qs_env, &
9475 energy=energy_inout)
9476
9477 END IF ! if perturbation only
9478
9479 CALL timestop(handle)
9480
9481 END SUBROUTINE wrap_up_xalmo_scf
9482
9483! **************************************************************************************************
9484!> \brief Computes tanh(alpha*x) of the matrix elements. Fails if |alpha*x| >= 1.
9485!> \param matrix ...
9486!> \param alpha ...
9487!> \author Ole Schuett
9488! **************************************************************************************************
9489 SUBROUTINE tanh_of_elements(matrix, alpha)
9490 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
9491 REAL(kind=dp), INTENT(IN) :: alpha
9492
9493 CHARACTER(len=*), PARAMETER :: routinen = 'tanh_of_elements'
9494
9495 INTEGER :: handle
9496 REAL(kind=dp), DIMENSION(:, :), POINTER :: block
9497 TYPE(dbcsr_iterator_type) :: iter
9498
9499 CALL timeset(routinen, handle)
9500 CALL dbcsr_iterator_start(iter, matrix)
9501 DO WHILE (dbcsr_iterator_blocks_left(iter))
9502 CALL dbcsr_iterator_next_block(iter, block=block)
9503 block = tanh(alpha*block)
9504 END DO
9505 CALL dbcsr_iterator_stop(iter)
9506 CALL timestop(handle)
9507
9508 END SUBROUTINE tanh_of_elements
9509
9510! **************************************************************************************************
9511!> \brief Computes d(tanh(alpha*x)) / dx of the matrix elements. Fails if |alpha*x| >= 1.
9512!> \param matrix ...
9513!> \param alpha ...
9514!> \author Ole Schuett
9515! **************************************************************************************************
9516 SUBROUTINE dtanh_of_elements(matrix, alpha)
9517 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
9518 REAL(kind=dp), INTENT(IN) :: alpha
9519
9520 CHARACTER(len=*), PARAMETER :: routinen = 'dtanh_of_elements'
9521
9522 INTEGER :: handle
9523 REAL(kind=dp), DIMENSION(:, :), POINTER :: block
9524 TYPE(dbcsr_iterator_type) :: iter
9525
9526 CALL timeset(routinen, handle)
9527 CALL dbcsr_iterator_start(iter, matrix)
9528 DO WHILE (dbcsr_iterator_blocks_left(iter))
9529 CALL dbcsr_iterator_next_block(iter, block=block)
9530 block = alpha*(1.0_dp - tanh(block)**2)
9531 END DO
9532 CALL dbcsr_iterator_stop(iter)
9533 CALL timestop(handle)
9534
9535 END SUBROUTINE dtanh_of_elements
9536
9537! **************************************************************************************************
9538!> \brief Computes 1/x of the matrix elements.
9539!> \param matrix ...
9540!> \author Ole Schuett
9541! **************************************************************************************************
9542 SUBROUTINE inverse_of_elements(matrix)
9543 TYPE(dbcsr_type), INTENT(INOUT) :: matrix
9544
9545 CHARACTER(len=*), PARAMETER :: routinen = 'inverse_of_elements'
9546
9547 INTEGER :: handle
9548 REAL(kind=dp), DIMENSION(:, :), POINTER :: block
9549 TYPE(dbcsr_iterator_type) :: iter
9550
9551 CALL timeset(routinen, handle)
9552 CALL dbcsr_iterator_start(iter, matrix)
9553 DO WHILE (dbcsr_iterator_blocks_left(iter))
9554 CALL dbcsr_iterator_next_block(iter, block=block)
9555 block = 1.0_dp/block
9556 END DO
9557 CALL dbcsr_iterator_stop(iter)
9558 CALL timestop(handle)
9559
9560 END SUBROUTINE inverse_of_elements
9561
9562! **************************************************************************************************
9563!> \brief Prints the sum of the elements for each block.
9564!> \param matrix ...
9565!> \param unit_nr ...
9566! **************************************************************************************************
9567 SUBROUTINE print_block_sum(matrix, unit_nr)
9568 TYPE(dbcsr_type), INTENT(IN) :: matrix
9569 INTEGER, INTENT(IN) :: unit_nr
9570
9571 CHARACTER(len=*), PARAMETER :: routinen = 'print_block_sum'
9572
9573 INTEGER :: col, handle, row
9574 REAL(kind=dp), DIMENSION(:, :), POINTER :: block
9575 TYPE(dbcsr_iterator_type) :: iter
9576
9577 CALL timeset(routinen, handle)
9578
9579 IF (unit_nr > 0) THEN
9580 CALL dbcsr_iterator_readonly_start(iter, matrix)
9581 DO WHILE (dbcsr_iterator_blocks_left(iter))
9582 CALL dbcsr_iterator_next_block(iter, row, col, block)
9583 WRITE (unit_nr, '(I6,I6,ES18.9)') row, col, sum(block)
9584 END DO
9585 CALL dbcsr_iterator_stop(iter)
9586 END IF
9587
9588 CALL timestop(handle)
9589 END SUBROUTINE print_block_sum
9590
9591END MODULE almo_scf_optimizer
9592
almo_scf_diis_types::almo_scf_diis_init
Definition almo_scf_diis_types.F:49
cp_dbcsr_api::dbcsr_create
Definition cp_dbcsr_api.F:194
cp_log_handling::cp_to_string
Definition cp_log_handling.F:90
domain_submatrix_methods::copy_submatrices
Definition domain_submatrix_methods.F:57
domain_submatrix_methods::init_submatrices
Definition domain_submatrix_methods.F:46
domain_submatrix_methods::release_submatrices
Definition domain_submatrix_methods.F:62
almo_scf_diis_types
A DIIS implementation for the ALMO-based SCF methods.
Definition almo_scf_diis_types.F:14
almo_scf_diis_types::almo_scf_diis_release
subroutine, public almo_scf_diis_release(diis_env)
destroys the diis structure
Definition almo_scf_diis_types.F:516
almo_scf_diis_types::almo_scf_diis_extrapolate
subroutine, public almo_scf_diis_extrapolate(diis_env, extr_var, d_extr_var)
extrapolates the variable using the saved history
Definition almo_scf_diis_types.F:341
almo_scf_diis_types::almo_scf_diis_push
subroutine, public almo_scf_diis_push(diis_env, var, err, d_var, d_err)
adds a variable-error pair to the diis structure
Definition almo_scf_diis_types.F:221
almo_scf_lbfgs_types
Limited memory BFGS.
Definition almo_scf_lbfgs_types.F:14
almo_scf_lbfgs_types::lbfgs_create
subroutine, public lbfgs_create(history, nspins, nstore)
create history storage for limited memory bfgs
Definition almo_scf_lbfgs_types.F:105
almo_scf_lbfgs_types::lbfgs_seed
subroutine, public lbfgs_seed(history, variable, gradient)
interface subroutine to store the first variable/gradient pair
Definition almo_scf_lbfgs_types.F:60
almo_scf_lbfgs_types::lbfgs_release
subroutine, public lbfgs_release(history)
release the bfgs history
Definition almo_scf_lbfgs_types.F:124
almo_scf_lbfgs_types::lbfgs_get_direction
subroutine, public lbfgs_get_direction(history, variable, gradient, direction)
interface subroutine to store a variable/gradient pair and predict direction
Definition almo_scf_lbfgs_types.F:79
almo_scf_methods
Subroutines for ALMO SCF.
Definition almo_scf_methods.F:15
almo_scf_methods::construct_domain_preconditioner
subroutine, public construct_domain_preconditioner(matrix_main, subm_s_inv, subm_s_inv_half, subm_s_half, subm_r_down, matrix_trimmer, dpattern, map, node_of_domain, preconditioner, bad_modes_projector_down, use_trimmer, eps_zero_eigenvalues, my_action, skip_inversion)
Constructs preconditioners for each domain -1. projected preconditioner 0. simple preconditioner.
Definition almo_scf_methods.F:2165
almo_scf_methods::almo_scf_ks_xx_to_tv_xx
subroutine, public almo_scf_ks_xx_to_tv_xx(almo_scf_env)
ALMOs by diagonalizing the KS domain submatrices computes both the occupied and virtual orbitals.
Definition almo_scf_methods.F:742
almo_scf_methods::xalmo_initial_guess
subroutine, public xalmo_initial_guess(m_guess, m_t_in, m_t0, m_quench_t, m_overlap, m_sigma_tmpl, nspins, xalmo_history, assume_t0_q0x, optimize_theta, envelope_amplitude, eps_filter, order_lanczos, eps_lanczos, max_iter_lanczos, nocc_of_domain)
create the initial guess for XALMOs
Definition almo_scf_methods.F:3127
almo_scf_methods::almo_scf_p_blk_to_t_blk
subroutine, public almo_scf_p_blk_to_t_blk(almo_scf_env, ionic)
computes occupied ALMOs from the superimposed atomic density blocks
Definition almo_scf_methods.F:1137
almo_scf_methods::pseudo_invert_diagonal_blk
subroutine, public pseudo_invert_diagonal_blk(matrix_in, matrix_out, nocc)
inverts block-diagonal blocks of a dbcsr_matrix
Definition almo_scf_methods.F:1074
almo_scf_methods::almo_scf_ks_blk_to_tv_blk
subroutine, public almo_scf_ks_blk_to_tv_blk(almo_scf_env)
computes ALMOs by diagonalizing the projected blocked KS matrix uses the diagonalization code for blo...
Definition almo_scf_methods.F:887
almo_scf_methods::apply_domain_operators
subroutine, public apply_domain_operators(matrix_in, matrix_out, operator1, operator2, dpattern, map, node_of_domain, my_action, filter_eps, matrix_trimmer, use_trimmer)
Parallel code for domain specific operations (my_action) 0. out = op1 * in.
Definition almo_scf_methods.F:2045
almo_scf_methods::construct_domain_r_down
subroutine, public construct_domain_r_down(matrix_t, matrix_sigma_inv, matrix_s, subm_r_down, dpattern, map, node_of_domain, filter_eps)
Constructs subblocks of the covariant-covariant projectors (i.e. DM without spin factor)
Definition almo_scf_methods.F:2512
almo_scf_methods::almo_scf_t_to_proj
subroutine, public almo_scf_t_to_proj(t, p, eps_filter, orthog_orbs, nocc_of_domain, s, sigma, sigma_inv, use_guess, smear, algorithm, para_env, blacs_env, eps_lanczos, max_iter_lanczos, inverse_accelerator, inv_eps_factor)
computes the idempotent density matrix from MOs MOs can be either orthogonal or non-orthogonal
Definition almo_scf_methods.F:1585
almo_scf_methods::construct_domain_s_inv
subroutine, public construct_domain_s_inv(matrix_s, subm_s_inv, dpattern, map, node_of_domain)
Constructs S_inv block for each domain.
Definition almo_scf_methods.F:2442
almo_scf_methods::almo_scf_ks_to_ks_blk
subroutine, public almo_scf_ks_to_ks_blk(almo_scf_env)
computes the projected KS from the total KS matrix also computes the DIIS error vector as a by-produc...
Definition almo_scf_methods.F:457
almo_scf_methods::get_overlap
subroutine, public get_overlap(bra, ket, overlap, metric, retain_overlap_sparsity, eps_filter, smear)
Computes the overlap matrix of MO orbitals.
Definition almo_scf_methods.F:1378
almo_scf_methods::fill_matrix_with_ones
subroutine, public fill_matrix_with_ones(matrix)
Fill all matrix blocks with 1.0_dp.
Definition almo_scf_methods.F:97
almo_scf_methods::apply_projector
subroutine, public apply_projector(psi_in, psi_out, psi_projector, metric, project_out, psi_projector_orthogonal, proj_in_template, eps_filter, sig_inv_projector, sig_inv_template)
applies projector to the orbitals |psi_out> = P |psi_in> OR |psi_out> = (1-P) |psi_in>,...
Definition almo_scf_methods.F:1792
almo_scf_methods::construct_domain_s_sqrt
subroutine, public construct_domain_s_sqrt(matrix_s, subm_s_sqrt, subm_s_sqrt_inv, dpattern, map, node_of_domain)
Constructs S^(+1/2) and S^(-1/2) submatrices for each domain.
Definition almo_scf_methods.F:2369
almo_scf_methods::orthogonalize_mos
subroutine, public orthogonalize_mos(ket, overlap, metric, retain_locality, only_normalize, nocc_of_domain, eps_filter, order_lanczos, eps_lanczos, max_iter_lanczos, overlap_sqrti, smear)
orthogonalize MOs
Definition almo_scf_methods.F:1463
almo_scf_methods::almo_scf_ks_to_ks_xx
subroutine, public almo_scf_ks_to_ks_xx(almo_scf_env)
builds projected KS matrices for the overlapping domains also computes the DIIS error vector as a by-...
Definition almo_scf_methods.F:112
almo_scf_methods::almo_scf_t_rescaling
subroutine, public almo_scf_t_rescaling(matrix_t, mo_energies, mu_of_domain, real_ne_of_domain, spin_kts, smear_e_temp, ndomains, nocc_of_domain)
Apply an occupation-rescaling trick to ALMOs for smearing. Partially occupied orbitals are considered...
Definition almo_scf_methods.F:1286
almo_scf_optimizer
Optimization routines for all ALMO-based SCF methods.
Definition almo_scf_optimizer.F:15
almo_scf_optimizer::almo_scf_xalmo_trustr
subroutine, public almo_scf_xalmo_trustr(qs_env, almo_scf_env, optimizer, quench_t, matrix_t_in, matrix_t_out, perturbation_only, special_case)
Optimization of ALMOs using trust region minimizers.
Definition almo_scf_optimizer.F:7521
almo_scf_optimizer::almo_scf_xalmo_pcg
subroutine, public almo_scf_xalmo_pcg(qs_env, almo_scf_env, optimizer, quench_t, matrix_t_in, matrix_t_out, assume_t0_q0x, perturbation_only, special_case)
Optimization of ALMOs using PCG-like minimizers.
Definition almo_scf_optimizer.F:757
almo_scf_optimizer::almo_scf_xalmo_eigensolver
subroutine, public almo_scf_xalmo_eigensolver(qs_env, almo_scf_env, optimizer)
An eigensolver-based SCF to optimize extended ALMOs (i.e. ALMOs on overlapping domains)
Definition almo_scf_optimizer.F:441
almo_scf_optimizer::almo_scf_construct_nlmos
subroutine, public almo_scf_construct_nlmos(qs_env, optimizer, matrix_s, matrix_mo_in, matrix_mo_out, template_matrix_sigma, overlap_determinant, mat_distr_aos, virtuals, eps_filter)
Optimization of NLMOs using PCG minimizers.
Definition almo_scf_optimizer.F:1854
almo_scf_optimizer::almo_scf_block_diagonal
subroutine, public almo_scf_block_diagonal(qs_env, almo_scf_env, optimizer)
An SCF procedure that optimizes block-diagonal ALMOs using DIIS.
Definition almo_scf_optimizer.F:140
almo_scf_qs
Interface between ALMO SCF and QS.
Definition almo_scf_qs.F:14
almo_scf_qs::almo_scf_update_ks_energy
subroutine, public almo_scf_update_ks_energy(qs_env, energy, energy_singles_corr)
update qs_env total energy
Definition almo_scf_qs.F:761
almo_scf_qs::almo_dm_to_almo_ks
subroutine, public almo_dm_to_almo_ks(qs_env, matrix_p, matrix_ks, energy_total, eps_filter, mat_distr_aos, smear, kts_sum)
uses the ALMO density matrix to compute ALMO KS matrix and the new energy
Definition almo_scf_qs.F:704
almo_scf_qs::almo_dm_to_qs_env
subroutine, public almo_dm_to_qs_env(qs_env, matrix_p, mat_distr_aos)
return density matrix to the qs_env
Definition almo_scf_qs.F:595
almo_scf_qs::matrix_qs_to_almo
subroutine, public matrix_qs_to_almo(matrix_qs, matrix_almo, mat_distr_aos)
convert between two types of matrices: QS style to ALMO style
Definition almo_scf_qs.F:364
almo_scf_types
Types for all ALMO-based methods.
Definition almo_scf_types.F:15
cell_types
Handles all functions related to the CELL.
Definition cell_types.F:15
cp_blacs_env
methods related to the blacs parallel environment
Definition cp_blacs_env.F:15
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_dbcsr_api::dbcsr_scale
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
Definition cp_dbcsr_api.F:1188
cp_dbcsr_api::dbcsr_iterator_blocks_left
logical function, public dbcsr_iterator_blocks_left(iterator)
...
Definition cp_dbcsr_api.F:944
cp_dbcsr_api::dbcsr_iterator_stop
subroutine, public dbcsr_iterator_stop(iterator)
...
Definition cp_dbcsr_api.F:1050
cp_dbcsr_api::dbcsr_desymmetrize
subroutine, public dbcsr_desymmetrize(matrix_a, matrix_b)
...
Definition cp_dbcsr_api.F:525
cp_dbcsr_api::dbcsr_copy
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
Definition cp_dbcsr_api.F:371
cp_dbcsr_api::dbcsr_get_block_p
subroutine, public dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
...
Definition cp_dbcsr_api.F:693
cp_dbcsr_api::dbcsr_multiply
subroutine, public dbcsr_multiply(transa, transb, alpha, matrix_a, matrix_b, beta, matrix_c, first_row, last_row, first_column, last_column, first_k, last_k, retain_sparsity, filter_eps, flop)
...
Definition cp_dbcsr_api.F:1096
cp_dbcsr_api::dbcsr_get_info
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
Definition cp_dbcsr_api.F:808
cp_dbcsr_api::dbcsr_work_create
subroutine, public dbcsr_work_create(matrix, nblks_guess, sizedata_guess, n, work_mutable)
...
Definition cp_dbcsr_api.F:1307
cp_dbcsr_api::dbcsr_iterator_next_block
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset, transposed)
...
Definition cp_dbcsr_api.F:971
cp_dbcsr_api::dbcsr_filter
subroutine, public dbcsr_filter(matrix, eps)
...
Definition cp_dbcsr_api.F:658
cp_dbcsr_api::dbcsr_finalize
subroutine, public dbcsr_finalize(matrix)
...
Definition cp_dbcsr_api.F:673
cp_dbcsr_api::dbcsr_iterator_start
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
Definition cp_dbcsr_api.F:1012
cp_dbcsr_api::dbcsr_set
subroutine, public dbcsr_set(matrix, alpha)
...
Definition cp_dbcsr_api.F:1204
cp_dbcsr_api::dbcsr_release
subroutine, public dbcsr_release(matrix)
...
Definition cp_dbcsr_api.F:1142
cp_dbcsr_api::dbcsr_iterator_readonly_start
subroutine, public dbcsr_iterator_readonly_start(iterator, matrix, shared, dynamic, dynamic_byrows)
Like dbcsr_iterator_start() but with matrix being INTENT(IN). When invoking this routine,...
Definition cp_dbcsr_api.F:1033
cp_dbcsr_api::dbcsr_put_block
subroutine, public dbcsr_put_block(matrix, row, col, block, summation)
...
Definition cp_dbcsr_api.F:1125
cp_dbcsr_api::dbcsr_add
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
Definition cp_dbcsr_api.F:254
cp_dbcsr_api::dbcsr_distribution_get
subroutine, public dbcsr_distribution_get(dist, row_dist, col_dist, nrows, ncols, has_threads, group, mynode, numnodes, nprows, npcols, myprow, mypcol, pgrid, subgroups_defined, prow_group, pcol_group)
...
Definition cp_dbcsr_api.F:572
cp_dbcsr_cholesky
Interface to (sca)lapack for the Cholesky based procedures.
Definition cp_dbcsr_cholesky.F:17
cp_dbcsr_cholesky::cp_dbcsr_cholesky_decompose
subroutine, public cp_dbcsr_cholesky_decompose(matrix, n, para_env, blacs_env)
used to replace a symmetric positive def. matrix M with its cholesky decomposition U: M = U^T * U,...
Definition cp_dbcsr_cholesky.F:61
cp_dbcsr_cholesky::cp_dbcsr_cholesky_restore
subroutine, public cp_dbcsr_cholesky_restore(matrix, neig, matrixb, matrixout, op, pos, transa, para_env, blacs_env)
...
Definition cp_dbcsr_cholesky.F:176
cp_dbcsr_cholesky::cp_dbcsr_cholesky_invert
subroutine, public cp_dbcsr_cholesky_invert(matrix, n, para_env, blacs_env, uplo_to_full)
used to replace the cholesky decomposition by the inverse
Definition cp_dbcsr_cholesky.F:114
cp_dbcsr_contrib
Definition cp_dbcsr_contrib.F:8
cp_dbcsr_contrib::dbcsr_set_diag
subroutine, public dbcsr_set_diag(matrix, diag)
Copies the diagonal elements from the given array into the given matrix.
Definition cp_dbcsr_contrib.F:585
cp_dbcsr_contrib::dbcsr_get_diag
subroutine, public dbcsr_get_diag(matrix, diag)
Copies the diagonal elements from the given matrix into the given array.
Definition cp_dbcsr_contrib.F:544
cp_dbcsr_contrib::dbcsr_add_on_diag
subroutine, public dbcsr_add_on_diag(matrix, alpha)
Adds the given scalar to the diagonal of the matrix. Reserves any missing diagonal blocks.
Definition cp_dbcsr_contrib.F:331
cp_dbcsr_contrib::dbcsr_maxabs
real(dp) function, public dbcsr_maxabs(matrix)
Compute the maxabs norm of a dbcsr matrix.
Definition cp_dbcsr_contrib.F:94
cp_dbcsr_contrib::dbcsr_frobenius_norm
real(dp) function, public dbcsr_frobenius_norm(matrix)
Compute the frobenius norm of a dbcsr matrix.
Definition cp_dbcsr_contrib.F:127
cp_dbcsr_contrib::dbcsr_dot
subroutine, public dbcsr_dot(matrix_a, matrix_b, trace)
Computes the dot product of two matrices, also known as the trace of their matrix product.
Definition cp_dbcsr_contrib.F:367
cp_dbcsr_contrib::dbcsr_hadamard_product
subroutine, public dbcsr_hadamard_product(matrix_a, matrix_b, matrix_c)
Hadamard product: C = A . B (C needs to be different from A and B)
Definition cp_dbcsr_contrib.F:53
cp_external_control
Routines to handle the external control of CP2K.
Definition cp_external_control.F:15
cp_external_control::external_control
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...
Definition cp_external_control.F:91
cp_files
Utility routines to open and close files. Tracking of preconnections.
Definition cp_files.F:16
cp_files::open_file
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:311
cp_files::close_file
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:122
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_logger_get_default_unit_nr
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
Definition cp_log_handling.F:576
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
cp_output_handling
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
Definition cp_output_handling.F:25
cp_output_handling::cp_print_key_unit_nr
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)
...
Definition cp_output_handling.F:853
cp_output_handling::cp_print_key_finished_output
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,...
Definition cp_output_handling.F:1073
ct_methods
Cayley transformation methods.
Definition ct_methods.F:14
ct_methods::analytic_line_search
subroutine, public analytic_line_search(a, b, c, d, minima, nmins)
Finds real roots of a cubic equation ‍ a*x**3 + b*x**2 + c*x + d = 0 and returns only those roots for...
Definition ct_methods.F:1376
ct_methods::diagonalize_diagonal_blocks
subroutine, public diagonalize_diagonal_blocks(matrix, c, e)
Diagonalizes diagonal blocks of a symmetric dbcsr matrix and returs its eigenvectors.
Definition ct_methods.F:1497
ct_methods::ct_step_execute
subroutine, public ct_step_execute(cts_env)
Performs Cayley transformation.
Definition ct_methods.F:64
ct_types
Types for all cayley transformation methods.
Definition ct_types.F:14
ct_types::ct_step_env_clean
subroutine, public ct_step_env_clean(env)
...
Definition ct_types.F:353
ct_types::ct_step_env_set
subroutine, public ct_step_env_set(env, para_env, blacs_env, use_occ_orbs, use_virt_orbs, tensor_type, occ_orbs_orthogonal, virt_orbs_orthogonal, neglect_quadratic_term, update_p, update_q, eps_convergence, eps_filter, max_iter, p_index_up, p_index_down, q_index_up, q_index_down, matrix_ks, matrix_p, matrix_qp_template, matrix_pq_template, matrix_t, matrix_v, matrix_x_guess, calculate_energy_corr, conjugator, qq_preconditioner_full, pp_preconditioner_full)
...
Definition ct_types.F:288
ct_types::ct_step_env_init
subroutine, public ct_step_env_init(env)
...
Definition ct_types.F:111
ct_types::ct_step_env_get
subroutine, public ct_step_env_get(env, use_occ_orbs, use_virt_orbs, tensor_type, occ_orbs_orthogonal, virt_orbs_orthogonal, neglect_quadratic_term, update_p, update_q, eps_convergence, eps_filter, max_iter, p_index_up, p_index_down, q_index_up, q_index_down, matrix_ks, matrix_p, matrix_qp_template, matrix_pq_template, matrix_t, matrix_v, copy_matrix_x, energy_correction, calculate_energy_corr, converged, qq_preconditioner_full, pp_preconditioner_full)
...
Definition ct_types.F:190
domain_submatrix_methods
Subroutines to handle submatrices.
Definition domain_submatrix_methods.F:14
domain_submatrix_methods::maxnorm_submatrices
subroutine, public maxnorm_submatrices(submatrices, norm)
Computes the max norm of the collection of submatrices.
Definition domain_submatrix_methods.F:721
domain_submatrix_methods::construct_submatrices
subroutine, public construct_submatrices(matrix, submatrix, distr_pattern, domain_map, node_of_domain, job_type)
Constructs submatrices for each ALMO domain by collecting distributed DBCSR blocks to local arrays.
Definition domain_submatrix_methods.F:838
domain_submatrix_types
Types to handle submatrices.
Definition domain_submatrix_types.F:14
domain_submatrix_types::select_row
integer, parameter, public select_row
Definition domain_submatrix_types.F:26
input_constants
collects all constants needed in input so that they can be used without circular dependencies
Definition input_constants.F:18
input_constants::op_loc_pipek
integer, parameter, public op_loc_pipek
Definition input_constants.F:484
input_constants::xalmo_case_normal
integer, parameter, public xalmo_case_normal
Definition input_constants.F:1083
input_constants::xalmo_case_fully_deloc
integer, parameter, public xalmo_case_fully_deloc
Definition input_constants.F:1083
input_constants::xalmo_case_block_diag
integer, parameter, public xalmo_case_block_diag
Definition input_constants.F:1083
input_constants::cg_hestenes_stiefel
integer, parameter, public cg_hestenes_stiefel
Definition input_constants.F:1065
input_constants::op_loc_berry
integer, parameter, public op_loc_berry
Definition input_constants.F:484
input_constants::trustr_dogleg
integer, parameter, public trustr_dogleg
Definition input_constants.F:1073
input_constants::almo_scf_diag
integer, parameter, public almo_scf_diag
Definition input_constants.F:1054
input_constants::cg_fletcher
integer, parameter, public cg_fletcher
Definition input_constants.F:1065
input_constants::cg_fletcher_reeves
integer, parameter, public cg_fletcher_reeves
Definition input_constants.F:1065
input_constants::xalmo_prec_domain
integer, parameter, public xalmo_prec_domain
Definition input_constants.F:1080
input_constants::almo_scf_dm_sign
integer, parameter, public almo_scf_dm_sign
Definition input_constants.F:1054
input_constants::virt_full
integer, parameter, public virt_full
Definition input_constants.F:1092
input_constants::trustr_cauchy
integer, parameter, public trustr_cauchy
Definition input_constants.F:1073
input_constants::cg_dai_yuan
integer, parameter, public cg_dai_yuan
Definition input_constants.F:1065
input_constants::cg_liu_storey
integer, parameter, public cg_liu_storey
Definition input_constants.F:1065
input_constants::xalmo_prec_zero
integer, parameter, public xalmo_prec_zero
Definition input_constants.F:1080
input_constants::cg_hager_zhang
integer, parameter, public cg_hager_zhang
Definition input_constants.F:1065
input_constants::cg_zero
integer, parameter, public cg_zero
Definition input_constants.F:1065
input_constants::cg_polak_ribiere
integer, parameter, public cg_polak_ribiere
Definition input_constants.F:1065
input_constants::xalmo_prec_full
integer, parameter, public xalmo_prec_full
Definition input_constants.F:1080
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition input_section_types.F:15
input_section_types::section_vals_get_subs_vals
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
Definition input_section_types.F:735
iterate_matrix
Routines useful for iterative matrix calculations.
Definition iterate_matrix.F:13
iterate_matrix::determinant
recursive subroutine, public determinant(matrix, det, threshold)
Computes the determinant of a symmetric positive definite matrix using the trace of the matrix logari...
Definition iterate_matrix.F:85
iterate_matrix::invert_hotelling
subroutine, public invert_hotelling(matrix_inverse, matrix, threshold, use_inv_as_guess, norm_convergence, filter_eps, accelerator_order, max_iter_lanczos, eps_lanczos, silent)
invert a symmetric positive definite matrix by Hotelling's method explicit symmetrization makes this ...
Definition iterate_matrix.F:473
iterate_matrix::matrix_sqrt_newton_schulz
subroutine, public matrix_sqrt_newton_schulz(matrix_sqrt, matrix_sqrt_inv, matrix, threshold, order, eps_lanczos, max_iter_lanczos, symmetrize, converged, iounit)
compute the sqrt of a matrix via the sign function and the corresponding Newton-Schulz iterations the...
Definition iterate_matrix.F:1627
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
machine
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
machine::m_flush
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:124
machine::m_walltime
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition machine.F:141
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
particle_methods
Define methods related to particle_type.
Definition particle_methods.F:14
particle_methods::get_particle_set
subroutine, public get_particle_set(particle_set, qs_kind_set, first_sgf, last_sgf, nsgf, nmao, basis, ncgf)
Get the components of a particle set.
Definition particle_methods.F:121
particle_types
Define the data structure for the particle information.
Definition particle_types.F:19
preconditioner
computes preconditioners, and implements methods to apply them currently used in qs_ot
Definition preconditioner.F:15
qs_energy_types
Definition qs_energy_types.F:14
qs_energy
Perform a QUICKSTEP wavefunction optimization (single point)
Definition qs_energy.F:14
qs_environment_types
Definition qs_environment_types.F:14
qs_environment_types::get_qs_env
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, mimic, 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, sab_cneo, 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, matrix_vhxc, 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, xcint_weights, 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, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_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, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Definition qs_environment_types.F:534
qs_kind_types
Define the quickstep kind type and their sub types.
Definition qs_kind_types.F:23
qs_loc_utils
Some utilities for the construction of the localization environment.
Definition qs_loc_utils.F:13
qs_loc_utils::compute_berry_operator
subroutine, public compute_berry_operator(qs_env, cell, op_sm_set, dim_op)
Computes the Berry operator for periodic systems used to define the spread of the MOS Here the matrix...
Definition qs_loc_utils.F:508
qs_localization_methods
Localization methods such as 2x2 Jacobi rotations Steepest Decents Conjugate Gradient.
Definition qs_localization_methods.F:18
qs_localization_methods::initialize_weights
subroutine, public initialize_weights(cell, weights)
...
Definition qs_localization_methods.F:246
almo_scf_diis_types::almo_scf_diis_type
Definition almo_scf_diis_types.F:54
almo_scf_lbfgs_types::lbfgs_history_type
Definition almo_scf_lbfgs_types.F:41
almo_scf_types::almo_scf_env_type
Definition almo_scf_types.F:110
almo_scf_types::optimizer_options_type
Definition almo_scf_types.F:75
cell_types::cell_type
Type defining parameters related to the simulation cell.
Definition cell_types.F:60
cp_blacs_env::cp_blacs_env_type
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Definition cp_blacs_env.F:53
cp_dbcsr_api::dbcsr_distribution_type
Definition cp_dbcsr_api.F:182
cp_dbcsr_api::dbcsr_iterator_type
Definition cp_dbcsr_api.F:188
cp_dbcsr_api::dbcsr_p_type
Definition cp_dbcsr_api.F:172
cp_dbcsr_api::dbcsr_type
Definition cp_dbcsr_api.F:176
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
ct_types::ct_step_env_type
Definition ct_types.F:37
domain_submatrix_types::domain_map_type
Definition domain_submatrix_types.F:47
domain_submatrix_types::domain_submatrix_type
Definition domain_submatrix_types.F:32
input_section_types::section_vals_type
stores the values of a section
Definition input_section_types.F:127
message_passing::mp_comm_type
Definition message_passing.F:161
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:750
particle_types::particle_type
Definition particle_types.F:35
qs_energy_types::qs_energy_type
Definition qs_energy_types.F:25
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:222
qs_kind_types::qs_kind_type
Provides all information about a quickstep kind.
Definition qs_kind_types.F:190