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