diff --git a/src/admm_dm_methods.F b/src/admm_dm_methods.F index 507dae26d0..5f7e69a3f9 100644 --- a/src/admm_dm_methods.F +++ b/src/admm_dm_methods.F @@ -135,6 +135,7 @@ CONTAINS INTEGER :: ispin LOGICAL :: s_mstruct_changed + REAL(KIND=dp) :: threshold TYPE(admm_dm_type), POINTER :: admm_dm TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s_aux, matrix_s_mixed, rho_ao, & rho_ao_aux @@ -160,7 +161,8 @@ CONTAINS IF (s_mstruct_changed) THEN ! Calculate A = S_aux^(-1) * S_mixed CALL dbcsr_create(matrix_s_aux_inv, template=matrix_s_aux(1)%matrix, matrix_type="N") - CALL invert_Hotelling(matrix_s_aux_inv, matrix_s_aux(1)%matrix, admm_dm%eps_filter) + threshold = MAX(admm_dm%eps_filter, 1.0e-12_dp) + CALL invert_Hotelling(matrix_s_aux_inv, matrix_s_aux(1)%matrix, threshold) IF (.NOT. ASSOCIATED(admm_dm%matrix_A)) THEN ALLOCATE (admm_dm%matrix_A) diff --git a/src/almo_scf.F b/src/almo_scf.F index 885c94bb4e..990492c5b6 100644 --- a/src/almo_scf.F +++ b/src/almo_scf.F @@ -12,18 +12,18 @@ ! ************************************************************************************************** MODULE almo_scf USE almo_scf_methods, ONLY: almo_scf_p_blk_to_t_blk,& - almo_scf_t_blk_to_p,& - almo_scf_t_blk_to_t_blk_orthonormal,& + almo_scf_t_to_proj,& distribute_domains,& orthogonalize_mos USE almo_scf_optimizer, ONLY: almo_scf_block_diagonal,& almo_scf_xalmo_eigensolver,& almo_scf_xalmo_pcg - USE almo_scf_qs, ONLY: almo_scf_construct_quencher,& - almo_scf_init_qs,& + USE almo_scf_qs, ONLY: almo_dm_to_almo_ks,& + almo_scf_construct_quencher,& calculate_w_matrix_almo,& + construct_qs_mos,& + init_almo_ks_matrix_via_qs,& matrix_almo_create,& - matrix_almo_to_qs,& matrix_qs_to_almo USE almo_scf_types, ONLY: almo_mat_dim_aobasis,& almo_mat_dim_occ,& @@ -36,6 +36,7 @@ MODULE almo_scf USE atomic_kind_types, ONLY: atomic_kind_type USE bibliography, ONLY: Khaliullin2013,& Kolafa2004,& + Scheiber2018,& cite_reference USE cp_blacs_env, ONLY: cp_blacs_env_release,& cp_blacs_env_retain @@ -60,9 +61,10 @@ MODULE almo_scf almo_deloc_none, almo_deloc_scf, almo_deloc_x, almo_deloc_x_then_scf, & almo_deloc_xalmo_1diag, almo_deloc_xalmo_scf, almo_deloc_xalmo_x, almo_deloc_xk, & almo_domain_layout_molecular, almo_mat_distr_atomic, almo_mat_distr_molecular, & - almo_scf_diag, almo_scf_dm_sign, almo_scf_pcg, atomic_guess, molecular_guess, & - optimizer_diis, optimizer_pcg, restart_guess, virt_full, virt_number, virt_occ_size, & - xalmo_case_block_diag, xalmo_case_fully_deloc, xalmo_case_normal + almo_scf_diag, almo_scf_dm_sign, almo_scf_pcg, almo_scf_skip, atomic_guess, & + molecular_guess, optimizer_diis, optimizer_lin_eq_pcg, optimizer_pcg, restart_guess, & + virt_full, virt_number, virt_occ_size, xalmo_case_block_diag, xalmo_case_fully_deloc, & + xalmo_case_normal, xalmo_trial_r0_out USE input_section_types, ONLY: section_vals_get_subs_vals,& section_vals_type USE iterate_matrix, ONLY: invert_Hotelling,& @@ -75,17 +77,13 @@ MODULE almo_scf USE mscfg_types, ONLY: get_matrix_from_submatrices,& molecular_scf_guess_env_type USE particle_types, ONLY: particle_type - USE qs_energy_types, ONLY: qs_energy_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type USE qs_initial_guess, ONLY: calculate_atomic_block_dm,& calculate_mopac_dm USE qs_kind_types, ONLY: qs_kind_type - USE qs_ks_methods, ONLY: qs_ks_update_qs_env - USE qs_ks_types, ONLY: qs_ks_did_change USE qs_mo_types, ONLY: get_mo_set,& mo_set_p_type - USE qs_rho_methods, ONLY: qs_rho_update_rho USE qs_rho_types, ONLY: qs_rho_get,& qs_rho_type USE qs_scf_post_scf, ONLY: qs_scf_compute_properties @@ -196,6 +194,7 @@ CONTAINS almo_scf_env%opt_block_diag_pcg%optimizer_type = optimizer_pcg almo_scf_env%opt_xalmo_diis%optimizer_type = optimizer_diis almo_scf_env%opt_xalmo_pcg%optimizer_type = optimizer_pcg + almo_scf_env%opt_xalmo_newton_pcg_solver%optimizer_type = optimizer_lin_eq_pcg ! get info from the qs_env CALL get_qs_env(qs_env, & @@ -223,9 +222,6 @@ CONTAINS nmols = almo_scf_env%nmolecules natoms = almo_scf_env%natoms - ! parse the almo_scf section and set appropriate quantities - !CALL almo_scf_init_read_write_input(input, almo_scf_env) - ! Define groups: either atomic or molecular IF (almo_scf_env%domain_layout_mos == almo_domain_layout_molecular) THEN almo_scf_env%ndomains = almo_scf_env%nmolecules @@ -366,22 +362,57 @@ CONTAINS almo_scf_env%calc_forces = calc_forces IF (calc_forces) THEN - IF (almo_scf_env%deloc_method == almo_deloc_x .OR. & - almo_scf_env%deloc_method == almo_deloc_xalmo_x .OR. & - almo_scf_env%deloc_method == almo_deloc_xalmo_1diag) & - CPABORT(" Forces are not implemented for this method yet ") - ENDIF - - almo_scf_env%calc_forces = calc_forces - IF (calc_forces) THEN - IF (almo_scf_env%deloc_method == almo_deloc_x .OR. & - almo_scf_env%deloc_method == almo_deloc_xalmo_x .OR. & - almo_scf_env%deloc_method == almo_deloc_xalmo_1diag) & - CPABORT(" Forces are not implemented for this method yet ") + CALL cite_reference(Scheiber2018) + IF (almo_scf_env%deloc_method .EQ. almo_deloc_x .OR. & + almo_scf_env%deloc_method .EQ. almo_deloc_xalmo_x .OR. & + almo_scf_env%deloc_method .EQ. almo_deloc_xalmo_1diag) THEN + CPABORT("Forces for perturbative methods are NYI. Change DELOCALIZE_METHOD") + ENDIF + ! switch to ASPC after a certain number of exact steps is done + IF (almo_scf_env%almo_history%istore .GT. (almo_scf_env%almo_history%nstore+1)) THEN + IF (almo_scf_env%opt_block_diag_pcg%eps_error_early .GT. 0.0_dp) THEN + almo_scf_env%opt_block_diag_pcg%eps_error = almo_scf_env%opt_block_diag_pcg%eps_error_early + almo_scf_env%opt_block_diag_pcg%early_stopping_on = .TRUE. + IF (unit_nr > 0) WRITE (*, *) "ALMO_OPTIMIZER_PCG: EPS_ERROR_EARLY is on" + ENDIF + IF (almo_scf_env%opt_block_diag_diis%eps_error_early .GT. 0.0_dp) THEN + almo_scf_env%opt_block_diag_diis%eps_error = almo_scf_env%opt_block_diag_diis%eps_error_early + almo_scf_env%opt_block_diag_diis%early_stopping_on = .TRUE. + IF (unit_nr > 0) WRITE (*, *) "ALMO_OPTIMIZER_DIIS: EPS_ERROR_EARLY is on" + ENDIF + IF (almo_scf_env%opt_block_diag_pcg%max_iter_early .GT. 0) THEN + almo_scf_env%opt_block_diag_pcg%max_iter = almo_scf_env%opt_block_diag_pcg%max_iter_early + almo_scf_env%opt_block_diag_pcg%early_stopping_on = .TRUE. + IF (unit_nr > 0) WRITE (*, *) "ALMO_OPTIMIZER_PCG: MAX_ITER_EARLY is on" + ENDIF + IF (almo_scf_env%opt_block_diag_diis%max_iter_early .GT. 0) THEN + almo_scf_env%opt_block_diag_diis%max_iter = almo_scf_env%opt_block_diag_diis%max_iter_early + almo_scf_env%opt_block_diag_diis%early_stopping_on = .TRUE. + IF (unit_nr > 0) WRITE (*, *) "ALMO_OPTIMIZER_DIIS: MAX_ITER_EARLY is on" + ENDIF + ELSE + almo_scf_env%opt_block_diag_diis%early_stopping_on = .FALSE. + almo_scf_env%opt_block_diag_pcg%early_stopping_on = .FALSE. + ENDIF + IF (almo_scf_env%xalmo_history%istore .GT. (almo_scf_env%xalmo_history%nstore+1)) THEN + IF (almo_scf_env%opt_xalmo_pcg%eps_error_early .GT. 0.0_dp) THEN + almo_scf_env%opt_xalmo_pcg%eps_error = almo_scf_env%opt_xalmo_pcg%eps_error_early + almo_scf_env%opt_xalmo_pcg%early_stopping_on = .TRUE. + IF (unit_nr > 0) WRITE (*, *) "XALMO_OPTIMIZER_PCG: EPS_ERROR_EARLY is on" + ENDIF + IF (almo_scf_env%opt_xalmo_pcg%max_iter_early .GT. 0.0_dp) THEN + almo_scf_env%opt_xalmo_pcg%max_iter = almo_scf_env%opt_xalmo_pcg%max_iter_early + almo_scf_env%opt_xalmo_pcg%early_stopping_on = .TRUE. + IF (unit_nr > 0) WRITE (*, *) "XALMO_OPTIMIZER_PCG: MAX_ITER_EARLY is on" + ENDIF + ELSE + almo_scf_env%opt_xalmo_pcg%early_stopping_on = .FALSE. + ENDIF ENDIF ! create all matrices CALL almo_scf_env_create_matrices(almo_scf_env, matrix_s(1)%matrix) + ! set up matrix S and all required functions of S almo_scf_env%s_inv_done = .FALSE. almo_scf_env%s_sqrt_done = .FALSE. @@ -416,8 +447,12 @@ CONTAINS ALLOCATE (almo_scf_env%domain_r_down_up(ndomains, nspins)) CALL init_submatrices(almo_scf_env%domain_r_down_up) - ! initialization of the QS settings with the ALMO flavor - CALL almo_scf_init_qs(qs_env, almo_scf_env) + ! initialization of the KS matrix + CALL init_almo_ks_matrix_via_qs(qs_env, & + almo_scf_env%matrix_ks, & + almo_scf_env%mat_distr_aos, & + almo_scf_env%eps_filter) + CALL construct_qs_mos(qs_env, almo_scf_env) CALL timestop(handle) @@ -443,7 +478,7 @@ CONTAINS nspins, unit_nr INTEGER, DIMENSION(2) :: nelectron_spin LOGICAL :: aspc_guess, has_unit_metric - REAL(KIND=dp) :: alpha, cs_pos + REAL(KIND=dp) :: alpha, cs_pos, energy TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(cp_logger_type), POINTER :: logger TYPE(cp_para_env_type), POINTER :: para_env @@ -452,7 +487,6 @@ CONTAINS TYPE(dft_control_type), POINTER :: dft_control TYPE(molecular_scf_guess_env_type), POINTER :: mscfg_env TYPE(particle_type), DIMENSION(:), POINTER :: particle_set - TYPE(qs_energy_type), POINTER :: energy TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_rho_type), POINTER :: rho @@ -472,7 +506,6 @@ CONTAINS CALL get_qs_env(qs_env, & dft_control=dft_control, & matrix_s=matrix_s, & - energy=energy, & atomic_kind_set=atomic_kind_set, & qs_kind_set=qs_kind_set, & particle_set=particle_set, & @@ -532,7 +565,7 @@ CONTAINS DO ispin = 1, nspins ! copy the atomic-block dm into matrix_p_blk CALL matrix_qs_to_almo(rho_ao(ispin)%matrix, & - almo_scf_env%matrix_p_blk(ispin), almo_scf_env, & + almo_scf_env%matrix_p_blk(ispin), almo_scf_env%mat_distr_aos, & .FALSE.) CALL dbcsr_filter(almo_scf_env%matrix_p_blk(ispin), & almo_scf_env%eps_filter) @@ -597,27 +630,55 @@ CONTAINS ENDIF !aspc_guess? - CALL almo_scf_t_blk_to_t_blk_orthonormal(almo_scf_env) - CALL almo_scf_t_blk_to_p(almo_scf_env, & - use_sigma_inv_guess=.FALSE.) - DO ispin = 1, nspins - CALL matrix_almo_to_qs(almo_scf_env%matrix_p(ispin), & - rho_ao(ispin)%matrix, & - almo_scf_env) + + CALL orthogonalize_mos(ket=almo_scf_env%matrix_t_blk(ispin), & + overlap=almo_scf_env%matrix_sigma_blk(ispin), & + metric=almo_scf_env%matrix_s_blk(1), & + retain_locality=.TRUE., & + only_normalize=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + eps_filter=almo_scf_env%eps_filter, & + order_lanczos=almo_scf_env%order_lanczos, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos) + + CALL almo_scf_t_to_proj(t=almo_scf_env%matrix_t_blk(ispin), & + p=almo_scf_env%matrix_p(ispin), & + eps_filter=almo_scf_env%eps_filter, & + orthog_orbs=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + s=almo_scf_env%matrix_s(1), & + sigma=almo_scf_env%matrix_sigma(ispin), & + sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), & + use_guess=.FALSE., & + algorithm=almo_scf_env%sigma_inv_algorithm, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos, & + inv_eps_factor=almo_scf_env%matrix_iter_eps_error_factor, & + para_env=almo_scf_env%para_env, & + blacs_env=almo_scf_env%blacs_env) + ENDDO - CALL qs_rho_update_rho(rho, qs_env=qs_env) - CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.TRUE.) - CALL qs_ks_update_qs_env(qs_env, calculate_forces=.FALSE., & - just_energy=.FALSE.) + ! compute dm from the projector(s) + IF (nspins == 1) THEN + CALL dbcsr_scale(almo_scf_env%matrix_p(1), 2.0_dp) + ENDIF + + CALL almo_dm_to_almo_ks(qs_env, & + almo_scf_env%matrix_p, & + almo_scf_env%matrix_ks, & + energy, & + almo_scf_env%eps_filter, & + almo_scf_env%mat_distr_aos) IF (unit_nr > 0) THEN IF (almo_scf_env%almo_scf_guess .EQ. molecular_guess) THEN WRITE (unit_nr, '(T2,A38,F40.10)') "Single-molecule energy:", & SUM(mscfg_env%energy_of_frag) ENDIF - WRITE (unit_nr, '(T2,A38,F40.10)') "Energy of the initial guess:", energy%total + WRITE (unit_nr, '(T2,A38,F40.10)') "Energy of the initial guess:", energy WRITE (unit_nr, '()') ENDIF @@ -632,10 +693,10 @@ CONTAINS !> 2016.11 created [Rustam Z Khaliullin] !> \author Rustam Khaliullin ! ************************************************************************************************** - SUBROUTINE almo_scf_store_result(almo_scf_env) + SUBROUTINE almo_scf_store_extrapolation_data(almo_scf_env) TYPE(almo_scf_env_type) :: almo_scf_env - CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_store_result', & + CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_store_extrapolation_data', & routineP = moduleN//':'//routineN INTEGER :: handle, ispin, istore, unit_nr @@ -769,7 +830,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE almo_scf_store_result + END SUBROUTINE almo_scf_store_extrapolation_data ! ************************************************************************************************** !> \brief Prints out a short summary about the ALMO SCF job @@ -789,7 +850,8 @@ CONTAINS CHARACTER(len=13) :: neig_string CHARACTER(len=33) :: deloc_method_string - INTEGER :: handle, idomain, index1_prev + INTEGER :: handle, idomain, index1_prev, sum_temp + INTEGER, ALLOCATABLE, DIMENSION(:) :: nneighbors CALL timeset(routineN, handle) @@ -799,15 +861,19 @@ CONTAINS WRITE (unit_nr, '(T2,A,T48,E33.3)') "eps_filter:", almo_scf_env%eps_filter - WRITE (unit_nr, '(T2,A)') "optimization of block-diagonal ALMOs:" - SELECT CASE (almo_scf_env%almo_update_algorithm) - CASE (almo_scf_diag) - ! the DIIS algorith is the only choice for the diagonlaization-based algorithm - CALL print_optimizer_options(almo_scf_env%opt_block_diag_diis, unit_nr) - CASE (almo_scf_pcg) - ! print out PCG options - CALL print_optimizer_options(almo_scf_env%opt_block_diag_pcg, unit_nr) - END SELECT + IF (almo_scf_env%almo_update_algorithm .EQ. almo_scf_skip) THEN + WRITE (unit_nr, '(T2,A)') "skip optimization of block-diagonal ALMOs" + ELSE + WRITE (unit_nr, '(T2,A)') "optimization of block-diagonal ALMOs:" + SELECT CASE (almo_scf_env%almo_update_algorithm) + CASE (almo_scf_diag) + ! the DIIS algorith is the only choice for the diagonlaization-based algorithm + CALL print_optimizer_options(almo_scf_env%opt_block_diag_diis, unit_nr) + CASE (almo_scf_pcg) + ! print out PCG options + CALL print_optimizer_options(almo_scf_env%opt_block_diag_pcg, unit_nr) + END SELECT + ENDIF SELECT CASE (almo_scf_env%deloc_method) CASE (almo_deloc_none) @@ -883,35 +949,118 @@ CONTAINS ! WRITE(unit_nr,'(T2,A,T48,A33)') "Parallel distribution for MOs","MOLECULAR" !END SELECT + ! print fragment's statistics WRITE (unit_nr, '(T2,A)') REPEAT("-", 79) + WRITE (unit_nr, '(T2,A,T48,I33)') "Total fragments:", & + almo_scf_env%ndomains - IF (almo_scf_env%ndomains .LE. 200) THEN + sum_temp = SUM(almo_scf_env%nbasis_of_domain(:)) + WRITE (unit_nr, '(T2,A,T53,I5,F9.2,I5,I9)') & + "Basis set size per fragment (min, av, max, total):", & + MINVAL(almo_scf_env%nbasis_of_domain(:)), & + (1.0_dp*sum_temp)/almo_scf_env%ndomains, & + MAXVAL(almo_scf_env%nbasis_of_domain(:)), & + sum_temp + !WRITE (unit_nr, '(T2,I13,F13.3,I13,I13)') & + ! MINVAL(almo_scf_env%nbasis_of_domain(:)), & + ! (1.0_dp*sum_temp) / almo_scf_env%ndomains, & + ! MAXVAL(almo_scf_env%nbasis_of_domain(:)), & + ! sum_temp + + sum_temp = SUM(almo_scf_env%nocc_of_domain(:, :)) + WRITE (unit_nr, '(T2,A,T53,I5,F9.2,I5,I9)') & + "Occupied MOs per fragment (min, av, max, total):", & + MINVAL(SUM(almo_scf_env%nocc_of_domain, DIM=2)), & + (1.0_dp*sum_temp)/almo_scf_env%ndomains, & + MAXVAL(SUM(almo_scf_env%nocc_of_domain, DIM=2)), & + sum_temp + !WRITE (unit_nr, '(T2,I13,F13.3,I13,I13)') & + ! MINVAL( SUM(almo_scf_env%nocc_of_domain, DIM=2) ), & + ! (1.0_dp*sum_temp) / almo_scf_env%ndomains, & + ! MAXVAL( SUM(almo_scf_env%nocc_of_domain, DIM=2) ), & + ! sum_temp + + sum_temp = SUM(almo_scf_env%nvirt_of_domain(:, :)) + WRITE (unit_nr, '(T2,A,T53,I5,F9.2,I5,I9)') & + "Virtual MOs per fragment (min, av, max, total):", & + MINVAL(SUM(almo_scf_env%nvirt_of_domain, DIM=2)), & + (1.0_dp*sum_temp)/almo_scf_env%ndomains, & + MAXVAL(SUM(almo_scf_env%nvirt_of_domain, DIM=2)), & + sum_temp + !WRITE (unit_nr, '(T2,I13,F13.3,I13,I13)') & + ! MINVAL( SUM(almo_scf_env%nvirt_of_domain, DIM=2) ), & + ! (1.0_dp*sum_temp) / almo_scf_env%ndomains, & + ! MAXVAL( SUM(almo_scf_env%nvirt_of_domain, DIM=2) ), & + ! sum_temp + + sum_temp = SUM(almo_scf_env%charge_of_domain(:)) + WRITE (unit_nr, '(T2,A,T53,I5,F9.2,I5,I9)') & + "Charges per fragment (min, av, max, total):", & + MINVAL(almo_scf_env%charge_of_domain(:)), & + (1.0_dp*sum_temp)/almo_scf_env%ndomains, & + MAXVAL(almo_scf_env%charge_of_domain(:)), & + sum_temp + !WRITE (unit_nr, '(T2,I13,F13.3,I13,I13)') & + ! MINVAL(almo_scf_env%charge_of_domain(:)), & + ! (1.0_dp*sum_temp) / almo_scf_env%ndomains, & + ! MAXVAL(almo_scf_env%charge_of_domain(:)), & + ! sum_temp + + ! compute the number of neighbors of each fragment + ALLOCATE (nneighbors(almo_scf_env%ndomains)) + + DO idomain = 1, almo_scf_env%ndomains + + IF (idomain .EQ. 1) THEN + index1_prev = 1 + ELSE + index1_prev = almo_scf_env%domain_map(1)%index1(idomain-1) + ENDIF + + SELECT CASE (almo_scf_env%deloc_method) + CASE (almo_deloc_none) + nneighbors(idomain) = 0 + CASE (almo_deloc_x, almo_deloc_scf, almo_deloc_x_then_scf) + nneighbors(idomain) = almo_scf_env%ndomains-1 ! minus self + CASE (almo_deloc_xalmo_1diag, almo_deloc_xalmo_x, almo_deloc_xalmo_scf) + nneighbors(idomain) = almo_scf_env%domain_map(1)%index1(idomain)-index1_prev-1 ! minus self + CASE DEFAULT + nneighbors(idomain) = -1 + END SELECT + + ENDDO ! cycle over domains + + sum_temp = SUM(nneighbors(:)) + WRITE (unit_nr, '(T2,A,T53,I5,F9.2,I5,I9)') & + "Deloc. neighbors of fragment (min, av, max, total):", & + MINVAL(nneighbors(:)), & + (1.0_dp*sum_temp)/almo_scf_env%ndomains, & + MAXVAL(nneighbors(:)), & + sum_temp + + WRITE (unit_nr, '(T2,A)') REPEAT("-", 79) + WRITE (unit_nr, '()') + + IF (almo_scf_env%ndomains .LE. 64) THEN ! print fragment info - WRITE (unit_nr, '(T2,A13,A13,A13,A13,A13,A13)') & + WRITE (unit_nr, '(T2,A10,A13,A13,A13,A13,A13)') & "Fragment", "Basis Set", "Occupied", "Virtual", "Charge", "Deloc Neig" !,"Discarded Virt" WRITE (unit_nr, '(T2,A)') REPEAT("-", 79) DO idomain = 1, almo_scf_env%ndomains - IF (idomain .EQ. 1) THEN - index1_prev = 1 - ELSE - index1_prev = almo_scf_env%domain_map(1)%index1(idomain-1) - ENDIF - SELECT CASE (almo_scf_env%deloc_method) CASE (almo_deloc_none) neig_string = "NONE" CASE (almo_deloc_x, almo_deloc_scf, almo_deloc_x_then_scf) neig_string = "ALL" CASE (almo_deloc_xalmo_1diag, almo_deloc_xalmo_x, almo_deloc_xalmo_scf) - WRITE (neig_string, '(I13)') & - almo_scf_env%domain_map(1)%index1(idomain)-index1_prev-1 ! minus self + WRITE (neig_string, '(I13)') nneighbors(idomain) CASE DEFAULT neig_string = "N/A" END SELECT - WRITE (unit_nr, '(T2,I13,I13,I13,I13,I13,A13)') & + WRITE (unit_nr, '(T2,I10,I13,I13,I13,I13,A13)') & idomain, almo_scf_env%nbasis_of_domain(idomain), & SUM(almo_scf_env%nocc_of_domain(idomain, :)), & SUM(almo_scf_env%nvirt_of_domain(idomain, :)), & @@ -938,8 +1087,8 @@ CONTAINS index1_prev = almo_scf_env%domain_map(1)%index1(idomain-1) ENDIF - WRITE (unit_nr, '(T2,I13,":")') idomain - WRITE (unit_nr, '(T15,5I13)') & + WRITE (unit_nr, '(T2,I10,":")') idomain + WRITE (unit_nr, '(T12,11I6)') & almo_scf_env%domain_map(1)%pairs & (index1_prev:almo_scf_env%domain_map(1)%index1(idomain)-1, 1) ! includes self @@ -947,13 +1096,19 @@ CONTAINS END SELECT - WRITE (unit_nr, '(T2,A)') REPEAT("-", 79) + ELSE ! too big to print details for each fragment - ENDIF + WRITE (unit_nr, '(T2,A)') "The system is too big to print details for each fragment." + + ENDIF ! how many fragments? + + WRITE (unit_nr, '(T2,A)') REPEAT("-", 79) WRITE (unit_nr, '()') - ENDIF + DEALLOCATE (nneighbors) + + ENDIF ! unit_nr > 0 CALL timestop(handle) @@ -997,9 +1152,9 @@ CONTAINS CALL dbcsr_add_on_diag(almo_scf_env%matrix_s_blk(1), 1.0_dp) ELSE CALL matrix_qs_to_almo(matrix_s, almo_scf_env%matrix_s(1), & - almo_scf_env, .FALSE.) - CALL matrix_qs_to_almo(matrix_s, almo_scf_env%matrix_s_blk(1), & - almo_scf_env, .TRUE.) + almo_scf_env%mat_distr_aos, .FALSE.) + CALL dbcsr_copy(almo_scf_env%matrix_s_blk(1), & + almo_scf_env%matrix_s(1), keep_sparsity=.TRUE.) ENDIF CALL dbcsr_filter(almo_scf_env%matrix_s(1), almo_scf_env%eps_filter) @@ -1011,12 +1166,14 @@ CONTAINS almo_scf_env%matrix_s_blk(1), & threshold=almo_scf_env%eps_filter, & order=almo_scf_env%order_lanczos, & + !order=0, & eps_lanczos=almo_scf_env%eps_lanczos, & max_iter_lanczos=almo_scf_env%max_iter_lanczos) ELSE IF (almo_scf_env%almo_update_algorithm .EQ. almo_scf_dm_sign) THEN CALL invert_Hotelling(almo_scf_env%matrix_s_blk_inv(1), & almo_scf_env%matrix_s_blk(1), & - threshold=almo_scf_env%eps_filter) + threshold=almo_scf_env%eps_filter, & + filter_eps=almo_scf_env%eps_filter) ENDIF CALL timestop(handle) @@ -1051,7 +1208,8 @@ CONTAINS unit_nr = -1 ENDIF - IF (almo_scf_env%almo_update_algorithm .EQ. almo_scf_pcg) THEN + SELECT CASE (almo_scf_env%almo_update_algorithm) + CASE (almo_scf_pcg) ! ALMO PCG optimizer as a special case of XALMO PCG CALL almo_scf_xalmo_pcg(qs_env=qs_env, & @@ -1064,15 +1222,43 @@ CONTAINS perturbation_only=.FALSE., & special_case=xalmo_case_block_diag) - CALL almo_scf_t_blk_to_t_blk_orthonormal(almo_scf_env) + DO ispin = 1, almo_scf_env%nspins + CALL orthogonalize_mos(ket=almo_scf_env%matrix_t_blk(ispin), & + overlap=almo_scf_env%matrix_sigma_blk(ispin), & + metric=almo_scf_env%matrix_s_blk(1), & + retain_locality=.TRUE., & + only_normalize=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + eps_filter=almo_scf_env%eps_filter, & + order_lanczos=almo_scf_env%order_lanczos, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos) + ENDDO + !CALL almo_scf_t_blk_to_t_blk_orthonormal(almo_scf_env) - ELSE + CASE (almo_scf_diag) ! mixing/DIIS optimizer CALL almo_scf_block_diagonal(qs_env, almo_scf_env, & almo_scf_env%opt_block_diag_diis) - ENDIF + CASE (almo_scf_skip) + + DO ispin = 1, almo_scf_env%nspins + CALL orthogonalize_mos(ket=almo_scf_env%matrix_t_blk(ispin), & + overlap=almo_scf_env%matrix_sigma_blk(ispin), & + metric=almo_scf_env%matrix_s_blk(1), & + retain_locality=.TRUE., & + only_normalize=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + eps_filter=almo_scf_env%eps_filter, & + order_lanczos=almo_scf_env%order_lanczos, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos) + ENDDO + !CALL almo_scf_t_blk_to_t_blk_orthonormal(almo_scf_env) + + END SELECT ! we might need a copy of the converged KS and sigma_inv DO ispin = 1, almo_scf_env%nspins @@ -1220,7 +1406,8 @@ CONTAINS quench_t=no_quench, & matrix_t_in=almo_scf_env%matrix_t_blk, & matrix_t_out=almo_scf_env%matrix_t, & - assume_t0_q0x=.TRUE., & + !assume_t0_q0x=.TRUE., & + assume_t0_q0x=(almo_scf_env%xalmo_trial_wf .EQ. xalmo_trial_r0_out), & perturbation_only=.TRUE., & special_case=xalmo_case_fully_deloc) @@ -1252,7 +1439,8 @@ CONTAINS quench_t=almo_scf_env%quench_t, & matrix_t_in=almo_scf_env%matrix_t_blk, & matrix_t_out=almo_scf_env%matrix_t, & - assume_t0_q0x=.TRUE., & + !assume_t0_q0x=.TRUE., & + assume_t0_q0x=(almo_scf_env%xalmo_trial_wf .EQ. xalmo_trial_r0_out), & perturbation_only=.TRUE., & special_case=xalmo_case_normal) @@ -1284,7 +1472,8 @@ CONTAINS quench_t=almo_scf_env%quench_t, & matrix_t_in=almo_scf_env%matrix_t_blk, & matrix_t_out=almo_scf_env%matrix_t, & - assume_t0_q0x=.TRUE., & + !assume_t0_q0x=.TRUE., & + assume_t0_q0x=(almo_scf_env%xalmo_trial_wf .EQ. xalmo_trial_r0_out), & perturbation_only=.FALSE., & special_case=xalmo_case_normal) @@ -1358,39 +1547,44 @@ CONTAINS INTEGER :: handle, ispin TYPE(cp_fm_type), POINTER :: mo_coeff TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_w - TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: matrix_t_orthogonal + TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: matrix_t_processed TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos TYPE(qs_scf_env_type), POINTER :: scf_env CALL timeset(routineN, handle) - ! store the matrices for a next scf run - CALL almo_scf_store_result(almo_scf_env) + ! store matrices to speed up the next scf run + CALL almo_scf_store_extrapolation_data(almo_scf_env) ! orthogonalize orbitals before returning them to QS - ALLOCATE (matrix_t_orthogonal(almo_scf_env%nspins)) + ALLOCATE (matrix_t_processed(almo_scf_env%nspins)) DO ispin = 1, almo_scf_env%nspins - CALL dbcsr_create(matrix_t_orthogonal(ispin), & + CALL dbcsr_create(matrix_t_processed(ispin), & template=almo_scf_env%matrix_t(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_copy(matrix_t_orthogonal(ispin), & + CALL dbcsr_copy(matrix_t_processed(ispin), & almo_scf_env%matrix_t(ispin)) - CALL orthogonalize_mos(ket=matrix_t_orthogonal(ispin), & - overlap=almo_scf_env%matrix_sigma(ispin), & - metric=almo_scf_env%matrix_s(1), & - retain_locality=.FALSE., & - only_normalize=.FALSE., & - eps_filter=almo_scf_env%eps_filter, & - order_lanczos=almo_scf_env%order_lanczos, & - eps_lanczos=almo_scf_env%eps_lanczos, & - max_iter_lanczos=almo_scf_env%max_iter_lanczos) + IF (almo_scf_env%return_orthogonalized_mos) THEN + + CALL orthogonalize_mos(ket=matrix_t_processed(ispin), & + overlap=almo_scf_env%matrix_sigma(ispin), & + metric=almo_scf_env%matrix_s(1), & + retain_locality=.FALSE., & + only_normalize=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + eps_filter=almo_scf_env%eps_filter, & + order_lanczos=almo_scf_env%order_lanczos, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos) + ENDIF + ENDDO - ! return orthogonalized orbitals to QS + ! return orbitals to QS NULLIFY (mos, mo_coeff, scf_env) CALL get_qs_env(qs_env, mos=mos, scf_env=scf_env) @@ -1399,12 +1593,10 @@ CONTAINS ! Currently only fm version of mo_set is usable. ! First transform the matrix_t to fm version CALL get_mo_set(mos(ispin)%mo_set, mo_coeff=mo_coeff) - - CALL copy_dbcsr_to_fm(matrix_t_orthogonal(ispin), mo_coeff) - - CALL dbcsr_release(matrix_t_orthogonal(ispin)) + CALL copy_dbcsr_to_fm(matrix_t_processed(ispin), mo_coeff) + CALL dbcsr_release(matrix_t_processed(ispin)) ENDDO - DEALLOCATE (matrix_t_orthogonal) + DEALLOCATE (matrix_t_processed) ! calculate post scf properties ! CALL almo_post_scf_compute_properties(qs_env, almo_scf_env) @@ -2093,7 +2285,6 @@ CONTAINS !> \author Yifei Shi ! ************************************************************************************************** SUBROUTINE almo_post_scf_compute_properties(qs_env) - ! SUBROUTINE almo_post_scf_compute_properties(qs_env, almo_scf_env) TYPE(qs_environment_type), POINTER :: qs_env CHARACTER(len=*), PARAMETER :: routineN = 'almo_post_scf_compute_properties', & @@ -2102,8 +2293,6 @@ CONTAINS TYPE(qs_scf_env_type), POINTER :: scf_env TYPE(section_vals_type), POINTER :: dft_section, input -!TYPE(almo_scf_env_type) :: almo_scf_env - CALL get_qs_env(qs_env, scf_env=scf_env, input=input) dft_section => section_vals_get_subs_vals(input, "DFT") CALL qs_scf_compute_properties(qs_env, dft_section) diff --git a/src/almo_scf_env_methods.F b/src/almo_scf_env_methods.F index b110a0af4a..56d2a9c7fd 100644 --- a/src/almo_scf_env_methods.F +++ b/src/almo_scf_env_methods.F @@ -15,10 +15,12 @@ MODULE almo_scf_env_methods almo_scf_env_type USE cp_control_types, ONLY: dft_control_type USE input_constants, ONLY: & - almo_constraint_distance, almo_deloc_xalmo_1diag, almo_domain_layout_atomic, & - almo_domain_layout_molecular, almo_frz_crystal, almo_mat_distr_molecular, almo_scf_diag, & - almo_scf_pcg, cg_hager_zhang, do_bondparm_vdw, molecular_guess, tensor_orthogonal, & - virt_full, virt_minimal, virt_number + almo_constraint_distance, almo_deloc_none, almo_deloc_scf, almo_deloc_x, & + almo_deloc_x_then_scf, almo_deloc_xalmo_1diag, almo_domain_layout_atomic, & + almo_domain_layout_molecular, almo_frz_crystal, almo_mat_distr_molecular, & + almo_occ_vol_penalty_none, almo_scf_diag, almo_scf_pcg, almo_scf_skip, cg_hager_zhang, & + do_bondparm_vdw, molecular_guess, tensor_orthogonal, virt_full, virt_minimal, virt_number, & + xalmo_trial_r0_out USE input_section_types, ONLY: section_vals_get_subs_vals,& section_vals_type,& section_vals_val_get @@ -105,7 +107,8 @@ CONTAINS INTEGER :: handle TYPE(section_vals_type), POINTER :: almo_analysis_section, almo_opt_diis_section, & - almo_opt_pcg_section, almo_scf_section, xalmo_opt_pcg_section + almo_opt_pcg_section, almo_scf_section, matrix_iterate_section, penalty_section, & + xalmo_opt_newton_pcg_section, xalmo_opt_pcg_section CALL timeset(routineN, handle) @@ -117,12 +120,11 @@ CONTAINS xalmo_opt_pcg_section => section_vals_get_subs_vals(almo_scf_section, & "XALMO_OPTIMIZER_PCG") almo_analysis_section => section_vals_get_subs_vals(almo_scf_section, "ANALYSIS") - - ! RZK-warning the values of these keywords are hardcoded - ! but ideally they should also be read from the input file - almo_scf_env%order_lanczos = 3 - almo_scf_env%eps_lanczos = 1.0E-4_dp - almo_scf_env%max_iter_lanczos = 40 + xalmo_opt_newton_pcg_section => section_vals_get_subs_vals(xalmo_opt_pcg_section, & + "XALMO_NEWTON_PCG_SOLVER") + matrix_iterate_section => section_vals_get_subs_vals(almo_scf_section, & + "MATRIX_ITERATE") + penalty_section => section_vals_get_subs_vals(almo_scf_section, "PENALTY") ! read user input ! common ALMO options @@ -132,6 +134,10 @@ CONTAINS i_val=almo_scf_env%almo_scf_guess) CALL section_vals_val_get(almo_scf_section, "ALMO_ALGORITHM", & i_val=almo_scf_env%almo_update_algorithm) + CALL section_vals_val_get(almo_scf_section, "XALMO_TRIAL_WF", & + i_val=almo_scf_env%xalmo_trial_wf) + CALL section_vals_val_get(almo_scf_section, "MO_OVERLAP_INV_ALG", & + i_val=almo_scf_env%sigma_inv_algorithm) CALL section_vals_val_get(almo_scf_section, "DELOCALIZE_METHOD", & i_val=almo_scf_env%deloc_method) CALL section_vals_val_get(almo_scf_section, "XALMO_R_CUTOFF_FACTOR", & @@ -142,12 +148,27 @@ CONTAINS CALL section_vals_val_get(almo_scf_section, "XALMO_EXTRAPOLATION_ORDER", & i_val=almo_scf_env%xalmo_extrapolation_order) almo_scf_env%xalmo_extrapolation_order = MAX(0, almo_scf_env%xalmo_extrapolation_order) + CALL section_vals_val_get(almo_scf_section, "RETURN_ORTHOGONALIZED_MOS", & + l_val=almo_scf_env%return_orthogonalized_mos) + + CALL section_vals_val_get(matrix_iterate_section, "EPS_LANCZOS", & + r_val=almo_scf_env%eps_lanczos) + CALL section_vals_val_get(matrix_iterate_section, "ORDER_LANCZOS", & + i_val=almo_scf_env%order_lanczos) + CALL section_vals_val_get(matrix_iterate_section, "MAX_ITER_LANCZOS", & + i_val=almo_scf_env%max_iter_lanczos) + CALL section_vals_val_get(matrix_iterate_section, "EPS_TARGET_FACTOR", & + r_val=almo_scf_env%matrix_iter_eps_error_factor) ! optimizers CALL section_vals_val_get(almo_opt_diis_section, "EPS_ERROR", & r_val=almo_scf_env%opt_block_diag_diis%eps_error) CALL section_vals_val_get(almo_opt_diis_section, "MAX_ITER", & i_val=almo_scf_env%opt_block_diag_diis%max_iter) + CALL section_vals_val_get(almo_opt_diis_section, "EPS_ERROR_EARLY", & + r_val=almo_scf_env%opt_block_diag_diis%eps_error_early) + CALL section_vals_val_get(almo_opt_diis_section, "MAX_ITER_EARLY", & + i_val=almo_scf_env%opt_block_diag_diis%max_iter_early) CALL section_vals_val_get(almo_opt_diis_section, "N_DIIS", & i_val=almo_scf_env%opt_block_diag_diis%ndiis) @@ -155,6 +176,10 @@ CONTAINS r_val=almo_scf_env%opt_block_diag_pcg%eps_error) CALL section_vals_val_get(almo_opt_pcg_section, "MAX_ITER", & i_val=almo_scf_env%opt_block_diag_pcg%max_iter) + CALL section_vals_val_get(almo_opt_pcg_section, "EPS_ERROR_EARLY", & + r_val=almo_scf_env%opt_block_diag_pcg%eps_error_early) + CALL section_vals_val_get(almo_opt_pcg_section, "MAX_ITER_EARLY", & + i_val=almo_scf_env%opt_block_diag_pcg%max_iter_early) CALL section_vals_val_get(almo_opt_pcg_section, "MAX_ITER_OUTER_LOOP", & i_val=almo_scf_env%opt_block_diag_pcg%max_iter_outer_loop) CALL section_vals_val_get(almo_opt_pcg_section, "LIN_SEARCH_EPS_ERROR", & @@ -170,17 +195,39 @@ CONTAINS r_val=almo_scf_env%opt_xalmo_pcg%eps_error) CALL section_vals_val_get(xalmo_opt_pcg_section, "MAX_ITER", & i_val=almo_scf_env%opt_xalmo_pcg%max_iter) + CALL section_vals_val_get(xalmo_opt_pcg_section, "EPS_ERROR_EARLY", & + r_val=almo_scf_env%opt_xalmo_pcg%eps_error_early) + CALL section_vals_val_get(xalmo_opt_pcg_section, "MAX_ITER_EARLY", & + i_val=almo_scf_env%opt_xalmo_pcg%max_iter_early) CALL section_vals_val_get(xalmo_opt_pcg_section, "MAX_ITER_OUTER_LOOP", & i_val=almo_scf_env%opt_xalmo_pcg%max_iter_outer_loop) CALL section_vals_val_get(xalmo_opt_pcg_section, "LIN_SEARCH_EPS_ERROR", & r_val=almo_scf_env%opt_xalmo_pcg%lin_search_eps_error) CALL section_vals_val_get(xalmo_opt_pcg_section, "LIN_SEARCH_STEP_SIZE_GUESS", & r_val=almo_scf_env%opt_xalmo_pcg%lin_search_step_size_guess) + CALL section_vals_val_get(xalmo_opt_pcg_section, "PRECOND_FILTER_THRESHOLD", & + r_val=almo_scf_env%opt_xalmo_pcg%neglect_threshold) CALL section_vals_val_get(xalmo_opt_pcg_section, "CONJUGATOR", & i_val=almo_scf_env%opt_xalmo_pcg%conjugator) CALL section_vals_val_get(xalmo_opt_pcg_section, "PRECONDITIONER", & i_val=almo_scf_env%opt_xalmo_pcg%preconditioner) + CALL section_vals_val_get(xalmo_opt_newton_pcg_section, "EPS_ERROR", & + r_val=almo_scf_env%opt_xalmo_newton_pcg_solver%eps_error) + CALL section_vals_val_get(xalmo_opt_newton_pcg_section, "MAX_ITER", & + i_val=almo_scf_env%opt_xalmo_newton_pcg_solver%max_iter) + CALL section_vals_val_get(xalmo_opt_newton_pcg_section, "MAX_ITER_OUTER_LOOP", & + i_val=almo_scf_env%opt_xalmo_newton_pcg_solver%max_iter_outer_loop) + CALL section_vals_val_get(xalmo_opt_newton_pcg_section, "PRECONDITIONER", & + i_val=almo_scf_env%opt_xalmo_newton_pcg_solver%preconditioner) + + CALL section_vals_val_get(penalty_section, & + "OCCUPIED_VOLUME_PENALTY_COEFF", & + r_val=almo_scf_env%penalty%occ_vol_coeff) + CALL section_vals_val_get(penalty_section, & + "OCCUPIED_VOLUME_PENALTY_METHOD", & + i_val=almo_scf_env%penalty%occ_vol_method) + CALL section_vals_val_get(almo_analysis_section, "_SECTION_PARAMETERS_", & l_val=almo_scf_env%almo_analysis%do_analysis) CALL section_vals_val_get(almo_analysis_section, "FROZEN_MO_ENERGY_TERM", & @@ -296,8 +343,8 @@ CONTAINS almo_scf_env%constraint_type = almo_constraint_distance almo_scf_env%mu = -0.1_dp almo_scf_env%fixed_mu = .FALSE. - almo_scf_env%eps_prev_guess = almo_scf_env%eps_filter/100.0_dp almo_scf_env%mixing_fraction = 0.45_dp + almo_scf_env%eps_prev_guess = almo_scf_env%eps_filter/1000.0_dp almo_scf_env%deloc_cayley_tensor_type = tensor_orthogonal almo_scf_env%deloc_cayley_conjugator = cg_hager_zhang @@ -362,6 +409,17 @@ CONTAINS ENDIF ! check for conflicts between options + IF (almo_scf_env%xalmo_trial_wf .EQ. xalmo_trial_r0_out .AND. & + almo_scf_env%almo_update_algorithm .EQ. almo_scf_skip .AND. & + almo_scf_env%almo_scf_guess .NE. molecular_guess) THEN + CPABORT("R0 projector requires optimized ALMOs") + ENDIF + + IF (almo_scf_env%deloc_method .EQ. almo_deloc_none .AND. & + almo_scf_env%almo_update_algorithm .EQ. almo_scf_skip) THEN + CPABORT("No optimization requested") + ENDIF + IF (almo_scf_env%deloc_truncate_virt .EQ. virt_number .AND. & almo_scf_env%deloc_virt_per_domain .LE. 0) THEN CPABORT("specify a positive number of virtual orbitals") @@ -409,6 +467,15 @@ CONTAINS ENDIF ! end analysis settings + ! check penalty settings + IF (almo_scf_env%penalty%occ_vol_method .NE. almo_occ_vol_penalty_none) THEN + IF (almo_scf_env%deloc_method .NE. almo_deloc_x .AND. & + almo_scf_env%deloc_method .NE. almo_deloc_scf .AND. & + almo_scf_env%deloc_method .NE. almo_deloc_x_then_scf) THEN + CPABORT("Occupied volume penalty seems to work only with completely delocalized orbitals") + ENDIF + ENDIF ! end penalty settings + CALL timestop(handle) END SUBROUTINE almo_scf_init_read_write_input diff --git a/src/almo_scf_methods.F b/src/almo_scf_methods.F index c8491bbc99..01a8bea748 100644 --- a/src/almo_scf_methods.F +++ b/src/almo_scf_methods.F @@ -14,18 +14,22 @@ MODULE almo_scf_methods almo_scf_history_type USE bibliography, ONLY: Kolafa2004,& cite_reference + USE cp_blacs_env, ONLY: cp_blacs_env_type + USE cp_dbcsr_cholesky, ONLY: cp_dbcsr_cholesky_decompose,& + cp_dbcsr_cholesky_invert USE cp_log_handling, ONLY: cp_get_default_logger,& cp_logger_get_default_unit_nr,& cp_logger_type + USE cp_para_types, ONLY: cp_para_env_type USE dbcsr_api, ONLY: & - dbcsr_add, dbcsr_add_on_diag, dbcsr_copy, dbcsr_create, dbcsr_desymmetrize, & - dbcsr_distribution_get, dbcsr_distribution_type, dbcsr_filter, dbcsr_finalize, & - dbcsr_frobenius_norm, dbcsr_get_block_p, dbcsr_get_diag, dbcsr_get_info, & + dbcsr_add, dbcsr_add_on_diag, dbcsr_copy, dbcsr_create, dbcsr_distribution_get, & + dbcsr_distribution_type, dbcsr_filter, dbcsr_finalize, dbcsr_frobenius_norm, & + dbcsr_get_block_p, dbcsr_get_diag, dbcsr_get_info, dbcsr_get_stored_coordinates, & dbcsr_init_random, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, & dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_multiply, & - dbcsr_nblkcols_total, dbcsr_norm, dbcsr_norm_maxabsnorm, dbcsr_print, dbcsr_release, & - dbcsr_reserve_block2d, dbcsr_scale, dbcsr_set, dbcsr_set_diag, dbcsr_transposed, & - dbcsr_type, dbcsr_type_no_symmetry, dbcsr_type_symmetric, dbcsr_work_create + dbcsr_nblkcols_total, dbcsr_nblkrows_total, dbcsr_print, dbcsr_release, & + dbcsr_reserve_block2d, dbcsr_set, dbcsr_set_diag, dbcsr_transposed, dbcsr_type, & + dbcsr_type_no_symmetry, dbcsr_type_symmetric, dbcsr_work_create USE domain_submatrix_methods, ONLY: & add_submatrices, construct_dbcsr_from_submatrices, construct_submatrices, & copy_submatrices, copy_submatrix_data, init_submatrices, multiply_submatrices, & @@ -36,8 +40,12 @@ MODULE almo_scf_methods select_row_col USE input_constants, ONLY: almo_domain_layout_molecular,& almo_mat_distr_atomic,& - almo_scf_diag + almo_scf_diag,& + spd_inversion_dense_cholesky,& + spd_inversion_ls_hotelling,& + spd_inversion_ls_taylor USE iterate_matrix, ONLY: invert_Hotelling,& + invert_Taylor,& matrix_sqrt_Newton_Schulz USE kinds, ONLY: dp USE mathlib, ONLY: binomial @@ -51,12 +59,11 @@ MODULE almo_scf_methods CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'almo_scf_methods' PUBLIC almo_scf_ks_to_ks_blk, almo_scf_p_blk_to_t_blk, & - almo_scf_t_blk_to_p, almo_scf_t_blk_to_t_blk_orthonormal, & - almo_scf_t_to_p, almo_scf_ks_blk_to_tv_blk, & + almo_scf_t_to_proj, almo_scf_ks_blk_to_tv_blk, & almo_scf_ks_xx_to_tv_xx, & apply_projector, get_overlap, & generator_to_unitary, & - newton_grad_to_step, orthogonalize_mos, & + orthogonalize_mos, & pseudo_invert_diagonal_blk, construct_test, & construct_domain_preconditioner, & apply_domain_operators, & @@ -489,6 +496,8 @@ CONTAINS filter_eps=eps_multiply) ! 5. KS_blk=KS_blk-TMP4_blk + CALL dbcsr_copy(almo_scf_env%matrix_ks_blk(ispin), & + almo_scf_env%matrix_ks(ispin), keep_sparsity=.TRUE.) CALL dbcsr_add(almo_scf_env%matrix_ks_blk(ispin), & matrix_tmp4, & 1.0_dp, -1.0_dp) @@ -584,6 +593,7 @@ CONTAINS matrix_tmp_err, & 0.0_dp, almo_scf_env%matrix_err_blk(ispin), & filter_eps=eps_multiply) + ! subtract transpose CALL dbcsr_transposed(matrix_tmp_err, & almo_scf_env%matrix_err_blk(ispin)) @@ -790,9 +800,6 @@ CONTAINS CPABORT("DSYEV failed") END IF -!WRITE (*,*) "Domain", idomain ,"OCC energies", eigenvalues( 1:almo_scf_env%nocc_of_domain(idomain,ispin) ) -!WRITE (*,*) "Domain", idomain ,"VIR energies", eigenvalues( almo_scf_env%nocc_of_domain(idomain,ispin)+1 : iblock_size ) - ! Copy occupied eigenvectors IF (almo_scf_env%domain_t(idomain, ispin)%ncols .NE. & almo_scf_env%nocc_of_domain(idomain, ispin)) THEN @@ -907,14 +914,14 @@ CONTAINS DO WHILE (dbcsr_iterator_blocks_left(iter)) CALL dbcsr_iterator_next_block(iter, iblock_row, iblock_col, data_p, row_size=iblock_size) - block_needed = .FALSE. - - IF (iblock_row == iblock_col) THEN - block_needed = .TRUE. + IF (iblock_row .NE. iblock_col) THEN + CPABORT("off-diagonal block found") ENDIF - IF (.NOT. block_needed) THEN - CPABORT("off-diagonal block found") + block_needed = .TRUE. + IF (almo_scf_env%nocc_of_domain(iblock_col, ispin) .EQ. 0 .AND. & + almo_scf_env%nvirt_of_domain(iblock_col, ispin) .EQ. 0) THEN + block_needed = .FALSE. ENDIF IF (block_needed) THEN @@ -944,38 +951,39 @@ CONTAINS !!! THE CORRESPONDING DIAGONAL BLOCKS OF THE FOCK MATRIX: !!! !!! T, V, E_o, E_v - ! copy eigenvectors into two cp_dbcsr matrices - occupied and virtuals - NULLIFY (p_new_block) - CALL dbcsr_reserve_block2d(matrix_t_blk_orthog, iblock_row, iblock_col, p_new_block) - nocc_of_block = SIZE(p_new_block, 2) - CPASSERT(ASSOCIATED(p_new_block)) - CPASSERT(nocc_of_block .GT. 0) - p_new_block(:, :) = data_copy(:, 1:nocc_of_block) - ! now virtuals - NULLIFY (p_new_block) - CALL dbcsr_reserve_block2d(matrix_v_blk_orthog, iblock_row, iblock_col, p_new_block) - nvirt_of_block = SIZE(p_new_block, 2) - CPASSERT(ASSOCIATED(p_new_block)) - CPASSERT(nvirt_of_block .GT. 0) - !CPPrecondition((nvirt_of_block+nocc_of_block.eq.iblock_size),cp_failure_level,routineP,failure) - p_new_block(:, :) = data_copy(:, (nocc_of_block+1):(nocc_of_block+nvirt_of_block)) + ! copy eigenvectors into two dbcsr matrices - occupied and virtuals + nocc_of_block = almo_scf_env%nocc_of_domain(iblock_col, ispin) + IF (nocc_of_block .GT. 0) THEN + NULLIFY (p_new_block) + CALL dbcsr_reserve_block2d(matrix_t_blk_orthog, iblock_row, iblock_col, p_new_block) + CPASSERT(ASSOCIATED(p_new_block)) + p_new_block(:, :) = data_copy(:, 1:nocc_of_block) + ! copy eigenvalues into diagonal dbcsr matrix - Eoo + NULLIFY (p_new_block) + CALL dbcsr_reserve_block2d(almo_scf_env%matrix_eoo(ispin), iblock_row, iblock_col, p_new_block) + CPASSERT(ASSOCIATED(p_new_block)) + p_new_block(:, :) = 0.0_dp + DO orbital = 1, nocc_of_block + p_new_block(orbital, orbital) = eigenvalues(orbital) + ENDDO + ENDIF - ! copy eigenvalues into two diagonal cp_dbcsr matrices - Eoo and Evv - NULLIFY (p_new_block) - CALL dbcsr_reserve_block2d(almo_scf_env%matrix_eoo(ispin), iblock_row, iblock_col, p_new_block) - CPASSERT(ASSOCIATED(p_new_block)) - p_new_block(:, :) = 0.0_dp - DO orbital = 1, nocc_of_block - p_new_block(orbital, orbital) = eigenvalues(orbital) - ENDDO - ! virtual energies - NULLIFY (p_new_block) - CALL dbcsr_reserve_block2d(almo_scf_env%matrix_evv_full(ispin), iblock_row, iblock_col, p_new_block) - CPASSERT(ASSOCIATED(p_new_block)) - p_new_block(:, :) = 0.0_dp - DO orbital = 1, nvirt_of_block - p_new_block(orbital, orbital) = eigenvalues(nocc_of_block+orbital) - ENDDO + ! now virtuals + nvirt_of_block = almo_scf_env%nvirt_of_domain(iblock_col, ispin) + IF (nvirt_of_block .GT. 0) THEN + NULLIFY (p_new_block) + CALL dbcsr_reserve_block2d(matrix_v_blk_orthog, iblock_row, iblock_col, p_new_block) + CPASSERT(ASSOCIATED(p_new_block)) + p_new_block(:, :) = data_copy(:, (nocc_of_block+1):(nocc_of_block+nvirt_of_block)) + ! virtual energies + NULLIFY (p_new_block) + CALL dbcsr_reserve_block2d(almo_scf_env%matrix_evv_full(ispin), iblock_row, iblock_col, p_new_block) + CPASSERT(ASSOCIATED(p_new_block)) + p_new_block(:, :) = 0.0_dp + DO orbital = 1, nvirt_of_block + p_new_block(orbital, orbital) = eigenvalues(nocc_of_block+orbital) + ENDDO + ENDIF DEALLOCATE (WORK) DEALLOCATE (data_copy) @@ -1014,7 +1022,7 @@ CONTAINS END SUBROUTINE almo_scf_ks_blk_to_tv_blk ! ************************************************************************************************** -!> \brief inverts block-diagonal blocks of a cp_dbcsr_matrix +!> \brief inverts block-diagonal blocks of a dbcsr_matrix !> \param matrix_in ... !> \param matrix_out ... !> \param nocc ... @@ -1062,7 +1070,6 @@ CONTAINS range1=nocc(iblock_row), range2=nocc(iblock_row), & !range1_thr,range2_thr,& shift=1.0E-5_dp) - !!! IT IS EXTREMELY IMPORTANT THAT THE BLOCKS OF THE "OUT" !!! !!! MATRIX ARE DISTRIBUTED AS THE BLOCKS OF THE "IN" MATRIX !!! @@ -1173,7 +1180,7 @@ CONTAINS !!! IT IS EXTREMELY IMPORTANT THAT THE DIAGONAL BLOCKS OF THE !!! !!! P AND T MATRICES ARE LOCATED ON THE SAME NODES !!! - ! copy eigenvectors into two cp_dbcsr matrices - occupied and virtuals + ! copy eigenvectors into two dbcsr matrices - occupied and virtuals NULLIFY (p_new_block) CALL dbcsr_reserve_block2d(matrix_t_blk_tmp, & iblock_row, iblock_col, p_new_block) @@ -1284,131 +1291,6 @@ CONTAINS END SUBROUTINE get_overlap -!! ************************************************************************************************** -!!> \brief Create the overlap matrix of virtual orbitals -!!> \par History -!!> 2011.07 created [Rustam Z Khaliullin] -!!> \author Rustam Z Khaliullin -!! ************************************************************************************************** -! SUBROUTINE almo_scf_v_to_sigma_vv(almo_scf_env) -! -! TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env -! -! CHARACTER(LEN=*), PARAMETER :: & -! routineN = 'almo_scf_v_to_sigma_vv', & -! routineP = moduleN//':'//routineN -! -! TYPE(dbcsr_type) :: tmp -! INTEGER :: ispin, handle -! -! CALL timeset(routineN,handle) -! -! DO ispin=1,almo_scf_env%nspins -! -! CALL dbcsr_init(tmp) -! CALL dbcsr_create(tmp,& -! template=almo_scf_env%matrix_v(ispin),& -! matrix_type=dbcsr_type_no_symmetry) -! -! ! TMP=S.V -! CALL dbcsr_multiply("N","N",1.0_dp,& -! almo_scf_env%matrix_s(1),& -! almo_scf_env%matrix_v(ispin),& -! 0.0_dp,tmp,& -! filter_eps=almo_scf_env%eps_filter) -! -! ! Sig_vv=tr(V).S.V - get MO overlap -! CALL dbcsr_multiply("T","N",1.0_dp,& -! almo_scf_env%matrix_v(ispin),& -! tmp,& -! 0.0_dp,almo_scf_env%matrix_sigma_vv(ispin),& -! filter_eps=almo_scf_env%eps_filter) -! -! CALL dbcsr_release(tmp) -! -! END DO -! -! CALL timestop(handle) -! -! END SUBROUTINE almo_scf_v_to_sigma_vv - -!! ************************************************************************************************** -!!> \brief orthogonalize virtual oribitals within a domain -!!> \par History -!!> 2011.07 created [Rustam Z Khaliullin] -!!> \author Rustam Z Khaliullin -!! ************************************************************************************************** -! SUBROUTINE almo_scf_v_to_v_orthonormal_blk(almo_scf_env) -! -! TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env -! -! CHARACTER(LEN=*), PARAMETER :: & -! routineN = 'almo_scf_v_to_v_orthonormal_blk', & -! routineP = moduleN//':'//routineN -! -! TYPE(dbcsr_type) :: matrix_v_tmp,& -! sigma_vv_blk_sqrt,& -! sigma_vv_blk_sqrt_inv -! INTEGER :: ispin, handle -! -! -! CALL timeset(routineN,handle) -! -! DO ispin=1,almo_scf_env%nspins -! -! CALL dbcsr_init(matrix_v_tmp) -! CALL dbcsr_create(matrix_v_tmp,& -! template=almo_scf_env%matrix_v(ispin)) -! -! ! TMP=S.V -! CALL dbcsr_multiply("N", "N", 1.0_dp, almo_scf_env%matrix_s(1),& -! almo_scf_env%matrix_v(ispin),& -! 0.0_dp, matrix_v_tmp,& -! filter_eps=almo_scf_env%eps_filter) -! -! ! Sig_blk=tr(V).TMP - get blocked MO overlap -! CALL dbcsr_multiply("T", "N", 1.0_dp,& -! almo_scf_env%matrix_v(ispin),& -! matrix_v_tmp,& -! 0.0_dp, almo_scf_env%matrix_sigma_vv_blk(ispin),& -! filter_eps=almo_scf_env%eps_filter,& -! retain_sparsity=.TRUE.) -! -! CALL dbcsr_init(sigma_vv_blk_sqrt) -! CALL dbcsr_init(sigma_vv_blk_sqrt_inv) -! CALL dbcsr_create(sigma_vv_blk_sqrt,template=almo_scf_env%matrix_sigma_vv_blk(ispin),& -! matrix_type=dbcsr_type_no_symmetry) -! CALL dbcsr_create(sigma_vv_blk_sqrt_inv,template=almo_scf_env%matrix_sigma_vv_blk(ispin),& -! matrix_type=dbcsr_type_no_symmetry) -! -! ! compute sqrt and sqrt_inv of the blocked MO overlap -! CALL matrix_sqrt_Newton_Schulz(sigma_vv_blk_sqrt,sigma_vv_blk_sqrt_inv,& -! almo_scf_env%matrix_sigma_vv_blk(ispin),& -! threshold=almo_scf_env%eps_filter,& -! order=almo_scf_env%order_lanczos,& -! eps_lanczos=almo_scf_env%eps_lancsoz,& -! max_iter_lanczos=almo_scf_env%max_iter_lanczos) -! -! ! TMP_blk=V.SigSQRTInv_blk -! CALL dbcsr_multiply("N", "N", 1.0_dp,& -! almo_scf_env%matrix_v(ispin),& -! sigma_vv_blk_sqrt_inv,& -! 0.0_dp, matrix_v_tmp,& -! filter_eps=almo_scf_env%eps_filter) -! -! ! update the orbitals with the orthonormalized MOs -! CALL dbcsr_copy(almo_scf_env%matrix_v(ispin),matrix_v_tmp) -! -! CALL dbcsr_release (matrix_v_tmp) -! CALL dbcsr_release (sigma_vv_blk_sqrt) -! CALL dbcsr_release (sigma_vv_blk_sqrt_inv) -! -! END DO -! -! CALL timestop(handle) -! -! END SUBROUTINE almo_scf_v_to_v_orthonormal_blk - ! ************************************************************************************************** !> \brief orthogonalize MOs !> \param ket ... @@ -1416,24 +1298,28 @@ CONTAINS !> \param metric ... !> \param retain_locality ... !> \param only_normalize ... +!> \param nocc_of_domain ... !> \param eps_filter ... !> \param order_lanczos ... !> \param eps_lanczos ... !> \param max_iter_lanczos ... +!> \param overlap_sqrti ... !> \par History !> 2012.03 created [Rustam Z Khaliullin] !> \author Rustam Z Khaliullin ! ************************************************************************************************** SUBROUTINE orthogonalize_mos(ket, overlap, metric, retain_locality, only_normalize, & - eps_filter, order_lanczos, eps_lanczos, max_iter_lanczos) + nocc_of_domain, eps_filter, order_lanczos, eps_lanczos, max_iter_lanczos, overlap_sqrti) TYPE(dbcsr_type), INTENT(INOUT) :: ket, overlap TYPE(dbcsr_type), INTENT(IN) :: metric LOGICAL, INTENT(IN) :: retain_locality, only_normalize + INTEGER, DIMENSION(:), INTENT(IN) :: nocc_of_domain REAL(KIND=dp) :: eps_filter INTEGER, INTENT(IN) :: order_lanczos REAL(KIND=dp), INTENT(IN) :: eps_lanczos INTEGER, INTENT(IN) :: max_iter_lanczos + TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL :: overlap_sqrti CHARACTER(LEN=*), PARAMETER :: routineN = 'orthogonalize_mos', & routineP = moduleN//':'//routineN @@ -1474,11 +1360,15 @@ CONTAINS matrix_type=dbcsr_type_no_symmetry) ! compute sqrt and sqrt_inv of the blocked MO overlap + CALL set_zero_electron_blocks_in_mo_mo_matrix(overlap, nocc_of_domain, 1.0_dp) CALL matrix_sqrt_Newton_Schulz(matrix_sigma_blk_sqrt, matrix_sigma_blk_sqrt_inv, & overlap, threshold=eps_filter, & order=order_lanczos, & eps_lanczos=eps_lanczos, & max_iter_lanczos=max_iter_lanczos) + CALL set_zero_electron_blocks_in_mo_mo_matrix(overlap, nocc_of_domain, 0.0_dp) + !CALL set_zero_electron_blocks_in_mo_mo_matrix(matrix_sigma_blk_sqrt,nocc_of_domain,0.0_dp) + CALL set_zero_electron_blocks_in_mo_mo_matrix(matrix_sigma_blk_sqrt_inv, nocc_of_domain, 0.0_dp) CALL dbcsr_create(matrix_t_blk_tmp, & template=ket, & @@ -1489,11 +1379,16 @@ CONTAINS matrix_sigma_blk_sqrt_inv, & 0.0_dp, matrix_t_blk_tmp, & filter_eps=eps_filter) - !retain_sparsity=retain_locality,& ! update the orbitals with the orthonormalized MOs CALL dbcsr_copy(ket, matrix_t_blk_tmp) + ! return overlap SQRT_INV if necessary + IF (PRESENT(overlap_sqrti)) THEN + CALL dbcsr_copy(overlap_sqrti, & + matrix_sigma_blk_sqrt_inv) + ENDIF + CALL dbcsr_release(matrix_t_blk_tmp) CALL dbcsr_release(matrix_sigma_blk_sqrt) CALL dbcsr_release(matrix_sigma_blk_sqrt_inv) @@ -1502,83 +1397,6 @@ CONTAINS END SUBROUTINE orthogonalize_mos -! ************************************************************************************************** -!> \brief orthogonalize ALMOs within a domain (obsolete, use orthogonalize_mos) -!> \param almo_scf_env ... -!> \par History -!> 2011.06 created [Rustam Z Khaliullin] -!> \author Rustam Z Khaliullin -! ************************************************************************************************** - SUBROUTINE almo_scf_t_blk_to_t_blk_orthonormal(almo_scf_env) - - TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env - - CHARACTER(LEN=*), PARAMETER :: routineN = 'almo_scf_t_blk_to_t_blk_orthonormal', & - routineP = moduleN//':'//routineN - - INTEGER :: handle, ispin - TYPE(dbcsr_type) :: matrix_sigma_blk_sqrt, & - matrix_sigma_blk_sqrt_inv, & - matrix_t_blk_tmp - - CALL timeset(routineN, handle) - - DO ispin = 1, almo_scf_env%nspins - - CALL dbcsr_create(matrix_t_blk_tmp, & - template=almo_scf_env%matrix_t_blk(ispin), & - matrix_type=dbcsr_type_no_symmetry) - - ! TMP_blk=S_blk.T_blk - CALL dbcsr_multiply("N", "N", 1.0_dp, almo_scf_env%matrix_s_blk(1), & - almo_scf_env%matrix_t_blk(ispin), & - 0.0_dp, matrix_t_blk_tmp, & - filter_eps=almo_scf_env%eps_filter) - - ! Sig_blk=tr(T_blk).TMP_blk - get blocked MO overlap - CALL dbcsr_multiply("T", "N", 1.0_dp, & - almo_scf_env%matrix_t_blk(ispin), & - matrix_t_blk_tmp, & - 0.0_dp, almo_scf_env%matrix_sigma_blk(ispin), & - filter_eps=almo_scf_env%eps_filter, & - retain_sparsity=.TRUE.) - - ! RZK-warning try to use symmetry of the sqrt and sqrt_inv matrices - CALL dbcsr_create(matrix_sigma_blk_sqrt, template=almo_scf_env%matrix_sigma_blk(ispin), & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(matrix_sigma_blk_sqrt_inv, template=almo_scf_env%matrix_sigma_blk(ispin), & - matrix_type=dbcsr_type_no_symmetry) - - ! compute sqrt and sqrt_inv of the blocked MO overlap - CALL matrix_sqrt_Newton_Schulz(matrix_sigma_blk_sqrt, matrix_sigma_blk_sqrt_inv, & - almo_scf_env%matrix_sigma_blk(ispin), & - threshold=almo_scf_env%eps_filter, & - order=almo_scf_env%order_lanczos, & - eps_lanczos=almo_scf_env%eps_lanczos, & - max_iter_lanczos=almo_scf_env%max_iter_lanczos) - - ! TMP_blk=T_blk.SigSQRTInv_blk - CALL dbcsr_multiply("N", "N", 1.0_dp, & - almo_scf_env%matrix_t_blk(ispin), & - matrix_sigma_blk_sqrt_inv, & - 0.0_dp, matrix_t_blk_tmp, & - filter_eps=almo_scf_env%eps_filter, & - retain_sparsity=.TRUE.) - - ! update the orbitals with the orthonormalized ALMOs - CALL dbcsr_copy(almo_scf_env%matrix_t_blk(ispin), matrix_t_blk_tmp, & - keep_sparsity=.TRUE.) - - CALL dbcsr_release(matrix_t_blk_tmp) - CALL dbcsr_release(matrix_sigma_blk_sqrt) - CALL dbcsr_release(matrix_sigma_blk_sqrt_inv) - - END DO - - CALL timestop(handle) - - END SUBROUTINE almo_scf_t_blk_to_t_blk_orthonormal - ! ************************************************************************************************** !> \brief computes the idempotent density matrix from MOs !> MOs can be either orthogonal or non-orthogonal @@ -1586,46 +1404,76 @@ CONTAINS !> \param p ... !> \param eps_filter ... !> \param orthog_orbs ... +!> \param nocc_of_domain ... !> \param s ... !> \param sigma ... !> \param sigma_inv ... !> \param use_guess ... +!> \param algorithm to inver sigma: 0 - Hotelling (linear), 1 - Cholesky (cubic, low prefactor) +!> \param para_env ... +!> \param blacs_env ... +!> \param eps_lanczos ... +!> \param max_iter_lanczos ... +!> \param inverse_accelerator ... +!> \param inv_eps_factor ... !> \par History !> 2011.07 created [Rustam Z Khaliullin] !> \author Rustam Z Khaliullin ! ************************************************************************************************** - SUBROUTINE almo_scf_t_to_p(t, p, eps_filter, orthog_orbs, s, sigma, sigma_inv, & - use_guess) + SUBROUTINE almo_scf_t_to_proj(t, p, eps_filter, orthog_orbs, nocc_of_domain, s, sigma, sigma_inv, & + use_guess, algorithm, para_env, blacs_env, eps_lanczos, & + max_iter_lanczos, inverse_accelerator, inv_eps_factor) TYPE(dbcsr_type), INTENT(IN) :: t TYPE(dbcsr_type), INTENT(INOUT) :: p REAL(KIND=dp), INTENT(IN) :: eps_filter LOGICAL, INTENT(IN) :: orthog_orbs + INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: nocc_of_domain TYPE(dbcsr_type), INTENT(IN), OPTIONAL :: s TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL :: sigma, sigma_inv LOGICAL, INTENT(IN), OPTIONAL :: use_guess + INTEGER, INTENT(IN), OPTIONAL :: algorithm + TYPE(cp_para_env_type), OPTIONAL, POINTER :: para_env + TYPE(cp_blacs_env_type), OPTIONAL, POINTER :: blacs_env + REAL(KIND=dp), INTENT(IN), OPTIONAL :: eps_lanczos + INTEGER, INTENT(IN), OPTIONAL :: max_iter_lanczos, inverse_accelerator + REAL(KIND=dp), INTENT(IN), OPTIONAL :: inv_eps_factor - CHARACTER(LEN=*), PARAMETER :: routineN = 'almo_scf_t_to_p', & + CHARACTER(LEN=*), PARAMETER :: routineN = 'almo_scf_t_to_proj', & routineP = moduleN//':'//routineN - INTEGER :: handle + INTEGER :: handle, my_accelerator, my_algorithm LOGICAL :: use_sigma_inv_guess + REAL(KIND=dp) :: my_inv_eps_factor TYPE(dbcsr_type) :: t_tmp CALL timeset(routineN, handle) ! make sure that S, sigma and sigma_inv are present for non-orthogonal orbitals IF (.NOT. orthog_orbs) THEN - IF ((.NOT. PRESENT(s)) .OR. (.NOT. PRESENT(sigma)) .OR. (.NOT. PRESENT(sigma_inv))) THEN - CPABORT("") + IF ((.NOT. PRESENT(s)) .OR. (.NOT. PRESENT(sigma)) .OR. & + (.NOT. PRESENT(sigma_inv)) .OR. (.NOT. PRESENT(nocc_of_domain))) THEN + CPABORT("Nonorthogonal orbitals need more input") ENDIF ENDIF + my_algorithm = 0 + IF (PRESENT(algorithm)) my_algorithm = algorithm + + IF (my_algorithm == 1 .AND. (.NOT. PRESENT(para_env) .OR. .NOT. PRESENT(blacs_env))) & + CPABORT("PARA and BLACS env are necessary for cholesky algorithm") + use_sigma_inv_guess = .FALSE. IF (PRESENT(use_guess)) THEN use_sigma_inv_guess = use_guess ENDIF + my_accelerator = 1 + IF (PRESENT(inverse_accelerator)) my_accelerator = inverse_accelerator + + my_inv_eps_factor = 10.0_dp + IF (PRESENT(inv_eps_factor)) my_inv_eps_factor = inv_eps_factor + IF (orthog_orbs) THEN CALL dbcsr_multiply("N", "T", 1.0_dp, t, t, & @@ -1644,11 +1492,52 @@ CONTAINS filter_eps=eps_filter) ! invert MO overlap - CALL invert_Hotelling( & - matrix_inverse=sigma_inv, & - matrix=sigma, & - use_inv_as_guess=use_sigma_inv_guess, & - threshold=eps_filter) + CALL set_zero_electron_blocks_in_mo_mo_matrix(sigma, nocc_of_domain, 1.0_dp) + SELECT CASE (my_algorithm) + CASE (spd_inversion_ls_taylor) + + CALL invert_Taylor( & + matrix_inverse=sigma_inv, & + matrix=sigma, & + use_inv_as_guess=use_sigma_inv_guess, & + threshold=eps_filter*my_inv_eps_factor, & + filter_eps=eps_filter, & + !accelerator_order=my_accelerator, & + !eps_lanczos=eps_lanczos, & + !max_iter_lanczos=max_iter_lanczos, & + silent=.FALSE.) + + CASE (spd_inversion_ls_hotelling) + + CALL invert_Hotelling( & + matrix_inverse=sigma_inv, & + matrix=sigma, & + use_inv_as_guess=use_sigma_inv_guess, & + threshold=eps_filter*my_inv_eps_factor, & + filter_eps=eps_filter, & + accelerator_order=my_accelerator, & + eps_lanczos=eps_lanczos, & + max_iter_lanczos=max_iter_lanczos, & + silent=.FALSE.) + + CASE (spd_inversion_dense_cholesky) + + ! invert using cholesky + CALL dbcsr_copy(sigma_inv, sigma) + CALL cp_dbcsr_cholesky_decompose(sigma_inv, & + para_env=para_env, & + blacs_env=blacs_env) + CALL cp_dbcsr_cholesky_invert(sigma_inv, & + para_env=para_env, & + blacs_env=blacs_env, & + upper_to_full=.TRUE.) + CALL dbcsr_filter(sigma_inv, & + eps=eps_filter) + CASE DEFAULT + CPABORT("Illegal MO overalp inversion algorithm") + END SELECT + CALL set_zero_electron_blocks_in_mo_mo_matrix(sigma, nocc_of_domain, 0.0_dp) + CALL set_zero_electron_blocks_in_mo_mo_matrix(sigma_inv, nocc_of_domain, 0.0_dp) ! TMP=T.SigInv CALL dbcsr_multiply("N", "N", 1.0_dp, t, sigma_inv, 0.0_dp, t_tmp, & @@ -1664,7 +1553,60 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE almo_scf_t_to_p + END SUBROUTINE almo_scf_t_to_proj + +! ************************************************************************************************** +!> \brief self-explanatory +!> \param matrix ... +!> \param nocc_of_domain ... +!> \param value ... +!> \param +!> \par History +!> 2016.12 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE set_zero_electron_blocks_in_mo_mo_matrix(matrix, nocc_of_domain, value) + + TYPE(dbcsr_type), INTENT(INOUT) :: matrix + INTEGER, DIMENSION(:), INTENT(IN) :: nocc_of_domain + REAL(KIND=dp), INTENT(IN) :: value + + INTEGER :: hold, iblock_col, iblock_row, mynode, & + nblkrows_tot, row + LOGICAL :: found, tr + REAL(KIND=dp), DIMENSION(:, :), POINTER :: p_new_block + TYPE(dbcsr_distribution_type) :: dist + + CALL dbcsr_get_info(matrix, distribution=dist) + CALL dbcsr_distribution_get(dist, mynode=mynode) + !mynode = dbcsr_mp_mynode(dbcsr_distribution_mp(dbcsr_distribution(matrix))) + CALL dbcsr_work_create(matrix, work_mutable=.TRUE.) + + nblkrows_tot = dbcsr_nblkrows_total(matrix) + + DO row = 1, nblkrows_tot + IF (nocc_of_domain(row) == 0) THEN + tr = .FALSE. + iblock_row = row + iblock_col = row + CALL dbcsr_get_stored_coordinates(matrix, iblock_row, iblock_col, hold) + IF (hold .EQ. mynode) THEN + NULLIFY (p_new_block) + CALL dbcsr_get_block_p(matrix, iblock_row, iblock_col, p_new_block, found) + IF (found) THEN + p_new_block(1, 1) = value + ELSE + CALL dbcsr_reserve_block2d(matrix, iblock_row, iblock_col, p_new_block) + CPASSERT(ASSOCIATED(p_new_block)) + p_new_block(1, 1) = value + ENDIF + ENDIF ! mynode + ENDIF !zero-electron block + ENDDO + + CALL dbcsr_finalize(matrix) + + END SUBROUTINE set_zero_electron_blocks_in_mo_mo_matrix ! ************************************************************************************************** !> \brief applies projector to the orbitals @@ -1833,58 +1775,6 @@ CONTAINS ! ! END SUBROUTINE almo_scf_p_out_from_v -! ************************************************************************************************** -!> \brief computes the idempotent density matrix from ALMOs -!> \param almo_scf_env ... -!> \param use_sigma_inv_guess ... -!> \par History -!> 2011.06 created [Rustam Z Khaliullin] -!> 2011.07 converted into a wrapper which calls almo_scf_t_to_p -!> \author Rustam Z Khaliullin -! ************************************************************************************************** - SUBROUTINE almo_scf_t_blk_to_p(almo_scf_env, use_sigma_inv_guess) - - TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env - LOGICAL, INTENT(IN), OPTIONAL :: use_sigma_inv_guess - - CHARACTER(LEN=*), PARAMETER :: routineN = 'almo_scf_t_blk_to_p', & - routineP = moduleN//':'//routineN - - INTEGER :: handle, ispin - LOGICAL :: use_guess - REAL(KIND=dp) :: spin_factor - - CALL timeset(routineN, handle) - - use_guess = .FALSE. - IF (PRESENT(use_sigma_inv_guess)) THEN - use_guess = use_sigma_inv_guess - ENDIF - - DO ispin = 1, almo_scf_env%nspins - - CALL almo_scf_t_to_p(t=almo_scf_env%matrix_t_blk(ispin), & - p=almo_scf_env%matrix_p(ispin), & - eps_filter=almo_scf_env%eps_filter, & - orthog_orbs=.FALSE., & - s=almo_scf_env%matrix_s(1), & - sigma=almo_scf_env%matrix_sigma(ispin), & - sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), & - use_guess=use_guess) - - IF (almo_scf_env%nspins == 1) THEN - spin_factor = 2.0_dp - ELSE - spin_factor = 1.0_dp - ENDIF - CALL dbcsr_scale(almo_scf_env%matrix_p(ispin), spin_factor) - - END DO - - CALL timestop(handle) - - END SUBROUTINE almo_scf_t_blk_to_p - ! ************************************************************************************************** !> \brief computes a unitary matrix from an arbitrary "generator" matrix !> U = ( 1 - X + tr(X) ) ( 1 + X - tr(X) )^(-1) @@ -2096,32 +1986,40 @@ CONTAINS !> 0. simple preconditioner !> \param matrix_main ... !> \param subm_s_inv ... +!> \param subm_s_inv_half ... +!> \param subm_s_half ... !> \param subm_r_down ... !> \param matrix_trimmer ... !> \param dpattern ... !> \param map ... !> \param node_of_domain ... !> \param preconditioner ... +!> \param bad_modes_projector_down ... !> \param use_trimmer ... +!> \param eps_zero_eigenvalues ... !> \param my_action ... !> \par History !> 2013.01 created [Rustam Z. Khaliullin] !> \author Rustam Z. Khaliullin ! ************************************************************************************************** - SUBROUTINE construct_domain_preconditioner(matrix_main, subm_s_inv, & + SUBROUTINE 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, & - use_trimmer, my_action) + bad_modes_projector_down, use_trimmer, eps_zero_eigenvalues, my_action) TYPE(dbcsr_type), INTENT(INOUT) :: matrix_main TYPE(domain_submatrix_type), DIMENSION(:), & - INTENT(IN), OPTIONAL :: subm_s_inv, subm_r_down + INTENT(IN), OPTIONAL :: subm_s_inv, subm_s_inv_half, & + subm_s_half, subm_r_down TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL :: matrix_trimmer TYPE(dbcsr_type), INTENT(IN) :: dpattern TYPE(domain_map_type), INTENT(IN) :: map INTEGER, DIMENSION(:), INTENT(IN) :: node_of_domain TYPE(domain_submatrix_type), DIMENSION(:), & INTENT(INOUT) :: preconditioner + TYPE(domain_submatrix_type), DIMENSION(:), & + INTENT(INOUT), OPTIONAL :: bad_modes_projector_down LOGICAL, INTENT(IN), OPTIONAL :: use_trimmer + REAL(KIND=dp), INTENT(IN), OPTIONAL :: eps_zero_eigenvalues INTEGER, INTENT(IN) :: my_action CHARACTER(len=*), PARAMETER :: routineN = 'construct_domain_preconditioner', & @@ -2134,7 +2032,7 @@ CONTAINS LOGICAL :: matrix_r_required, & matrix_s_inv_required, & matrix_trimmer_required, my_use_trimmer - REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: Minv + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: Minv, proj_array TYPE(domain_submatrix_type), ALLOCATABLE, & DIMENSION(:) :: subm_main, subm_tmp, subm_tmp2 @@ -2259,14 +2157,55 @@ CONTAINS !!!TRIM subm_out=MATMUL(tmp,sigma) !!!TRIM deallocate(tmp) !!!TRIM ELSE - CALL pseudo_invert_matrix(A=subm_main(idomain)%mdata, Ainv=Minv, N=naos, method=1, & - range1=nmos(idomain), range2=n_domain_mos) + + IF (PRESENT(bad_modes_projector_down)) THEN + ALLOCATE (proj_array(naos, naos)) + ENDIF + + IF (PRESENT(eps_zero_eigenvalues)) THEN + IF (PRESENT(subm_s_inv_half)) THEN + CALL pseudo_invert_matrix(A=subm_main(idomain)%mdata, Ainv=Minv, N=naos, method=1, & + range1=nmos(idomain), range2=n_domain_mos, & + range1_thr=eps_zero_eigenvalues, & + bad_modes_projector_down=proj_array, & + s_inv_half=subm_s_inv_half(idomain)%mdata, & + s_half=subm_s_half(idomain)%mdata & + !metric_inv=subm_s_inv(idomain)%mdata & + ) + ELSE + CALL pseudo_invert_matrix(A=subm_main(idomain)%mdata, Ainv=Minv, N=naos, method=1, & + range1=nmos(idomain), range2=n_domain_mos, & + range1_thr=eps_zero_eigenvalues, & + bad_modes_projector_down=proj_array & + ) + ENDIF + ELSE + IF (PRESENT(subm_s_inv_half)) THEN + CALL pseudo_invert_matrix(A=subm_main(idomain)%mdata, Ainv=Minv, N=naos, method=1, & + range1=nmos(idomain), range2=n_domain_mos, & + bad_modes_projector_down=proj_array, & + s_inv_half=subm_s_inv_half(idomain)%mdata, & + s_half=subm_s_inv(idomain)%mdata) + ELSE + CALL pseudo_invert_matrix(A=subm_main(idomain)%mdata, Ainv=Minv, N=naos, method=1, & + range1=nmos(idomain), range2=n_domain_mos, & + bad_modes_projector_down=proj_array) + ENDIF + ENDIF ! eps_zero_eigenvalues !!!TRIM ENDIF CALL copy_submatrices(subm_main(idomain), preconditioner(idomain), .FALSE.) CALL copy_submatrix_data(Minv, preconditioner(idomain)) + IF (PRESENT(bad_modes_projector_down)) THEN + CALL copy_submatrices(subm_main(idomain), bad_modes_projector_down(idomain), .FALSE.) + CALL copy_submatrix_data(proj_array, bad_modes_projector_down(idomain)) + ENDIF + DEALLOCATE (Minv) + IF (PRESENT(bad_modes_projector_down)) THEN + DEALLOCATE (proj_array) + ENDIF ENDIF ! submatrix for the domain exists @@ -2377,7 +2316,6 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE construct_domain_s_inv(matrix_s, subm_s_inv, dpattern, map, & node_of_domain) - TYPE(dbcsr_type), INTENT(IN) :: matrix_s TYPE(domain_submatrix_type), DIMENSION(:), & INTENT(INOUT) :: subm_s_inv @@ -2434,7 +2372,7 @@ CONTAINS END SUBROUTINE construct_domain_s_inv ! ************************************************************************************************** -!> \brief Constructs subblocks of the covariant-covariant DM +!> \brief Constructs subblocks of the covariant-covariant projectors (i.e. DM without spin factor) !> \param matrix_t ... !> \param matrix_sigma_inv ... !> \param matrix_s ... @@ -2619,30 +2557,36 @@ CONTAINS !> \param range1 ... !> \param range2 ... !> \param range1_thr ... -!> \param range2_thr ... !> \param shift ... +!> \param bad_modes_projector_down ... +!> \param s_inv_half ... +!> \param s_half ... !> \par History !> 2012.04 created [Rustam Z. Khaliullin] !> \author Rustam Z. Khaliullin ! ************************************************************************************************** - SUBROUTINE pseudo_invert_matrix(A, Ainv, N, method, range1, range2, range1_thr, range2_thr, & - shift) + SUBROUTINE pseudo_invert_matrix(A, Ainv, N, method, range1, range2, range1_thr, & + shift, bad_modes_projector_down, s_inv_half, s_half) REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: A REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: Ainv INTEGER, INTENT(IN) :: N, method INTEGER, INTENT(IN), OPTIONAL :: range1, range2 - REAL(KIND=dp), INTENT(IN), OPTIONAL :: range1_thr, range2_thr, shift + REAL(KIND=dp), INTENT(IN), OPTIONAL :: range1_thr, shift + REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT), & + OPTIONAL :: bad_modes_projector_down + REAL(KIND=dp), DIMENSION(:, :), INTENT(IN), & + OPTIONAL :: s_inv_half, s_half CHARACTER(len=*), PARAMETER :: routineN = 'pseudo_invert_matrix', & routineP = moduleN//':'//routineN INTEGER :: handle, ii, INFO, jj, LWORK, range1_eiv, & range2_eiv, range3_eiv, unit_nr - LOGICAL :: use_ranges + LOGICAL :: use_both, use_ranges REAL(KIND=dp) :: my_shift REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues, WORK - REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: test, testN + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: temp1, temp2, temp3, temp4 TYPE(cp_logger_type), POINTER :: logger CALL timeset(routineN, handle) @@ -2656,17 +2600,20 @@ CONTAINS END IF IF (method .EQ. 1) THEN - IF (PRESENT(range1)) THEN - use_ranges = .TRUE. - IF (.NOT. PRESENT(range2)) THEN - CPABORT("SPECIFY TWO RANGES") - ENDIF + IF (PRESENT(range1) .AND. PRESENT(range1_thr)) THEN + use_both = .TRUE. ELSE - use_ranges = .FALSE. - IF ((.NOT. PRESENT(range1_thr)) .OR. (.NOT. PRESENT(range2_thr))) THEN - CPABORT("SPECIFY TWO THRESHOLDS") + use_both = .FALSE. + IF (PRESENT(range1)) THEN + use_ranges = .TRUE. + ELSE + use_ranges = .FALSE. ENDIF ENDIF + + IF ((PRESENT(s_half) .AND. (.NOT. PRESENT(s_inv_half))) .OR. (PRESENT(s_inv_half) .AND. (.NOT. PRESENT(s_half)))) THEN + CPABORT("Domain overlap matrix missing") + ENDIF ENDIF my_shift = 0.0_dp @@ -2700,62 +2647,105 @@ CONTAINS ! diagonalize first ALLOCATE (eigenvalues(N)) + ALLOCATE (temp1(N, N)) + ALLOCATE (temp4(N, N)) + IF (PRESENT(s_inv_half)) THEN + CALL DSYMM('L', 'U', N, N, 1.0_dp, s_inv_half, N, A, N, 0.0_dp, temp1, N) + CALL DSYMM('R', 'U', N, N, 1.0_dp, s_inv_half, N, temp1, N, 0.0_dp, Ainv, N) + ENDIF ! Query the optimal workspace for dsyev LWORK = -1 ALLOCATE (WORK(MAX(1, LWORK))) CALL DSYEV('V', 'L', N, Ainv, N, eigenvalues, WORK, LWORK, INFO) + LWORK = INT(WORK(1)) DEALLOCATE (WORK) ! Allocate the workspace and solve the eigenproblem ALLOCATE (WORK(MAX(1, LWORK))) CALL DSYEV('V', 'L', N, Ainv, N, eigenvalues, WORK, LWORK, INFO) + IF (INFO .NE. 0) THEN - IF (unit_nr > 0) WRITE (unit_nr, *) 'DSYEV ERROR MESSAGE: ', INFO - CPABORT("DSYEV failed") + IF (unit_nr > 0) WRITE (unit_nr, *) 'EIGENSYSTEM ERROR MESSAGE: ', INFO + CPABORT("Eigenproblem routine failed") END IF DEALLOCATE (WORK) !WRITE(*,*) "EIGENVALS: " !WRITE(*,'(4F13.9)') eigenvalues(:) - ! invert eigenvalues and use eigenvectors to compute the Hessian inverse - ! project out zero-eigenvalue directions - ALLOCATE (test(N, N)) + ! invert eigenvalues and use eigenvectors to compute pseudo Ainv + ! project out near-zero eigenvalue modes + ALLOCATE (temp2(N, N)) + IF (PRESENT(bad_modes_projector_down)) ALLOCATE (temp3(N, N)) + temp2(1:N, 1:N) = Ainv(1:N, 1:N) + range1_eiv = 0 range2_eiv = 0 range3_eiv = 0 - IF (use_ranges) THEN + + IF (use_both) THEN DO jj = 1, N - IF (jj .LE. range1) THEN - test(jj, :) = Ainv(:, jj)*0.0_dp + IF ((jj .LE. range2) .AND. (eigenvalues(jj) .LT. range1_thr)) THEN + temp1(jj, :) = temp2(:, jj)*0.0_dp + IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*1.0_dp range1_eiv = range1_eiv+1 - ELSE IF (jj .LE. range2) THEN - test(jj, :) = Ainv(:, jj)*1.0_dp - range2_eiv = range2_eiv+1 ELSE - test(jj, :) = Ainv(:, jj)/(eigenvalues(jj)+my_shift) - range3_eiv = range3_eiv+1 + temp1(jj, :) = temp2(:, jj)/(eigenvalues(jj)+my_shift) + IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*0.0_dp + range2_eiv = range2_eiv+1 ENDIF ENDDO ELSE - DO jj = 1, N - IF (eigenvalues(jj) .LT. range1_thr) THEN - test(jj, :) = Ainv(:, jj)*0.0_dp - range1_eiv = range1_eiv+1 - ELSE IF (eigenvalues(jj) .LT. range2_thr) THEN - test(jj, :) = Ainv(:, jj)*1.0_dp - range2_eiv = range2_eiv+1 - ELSE - test(jj, :) = Ainv(:, jj)/(eigenvalues(jj)+my_shift) - range3_eiv = range3_eiv+1 - ENDIF - ENDDO + IF (use_ranges) THEN + DO jj = 1, N + IF (jj .LE. range1) THEN + temp1(jj, :) = temp2(:, jj)*0.0_dp + IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*1.0_dp + range1_eiv = range1_eiv+1 + ELSE IF (jj .LE. range2) THEN + temp1(jj, :) = temp2(:, jj)*1.0_dp + IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*1.0_dp + range2_eiv = range2_eiv+1 + ELSE + temp1(jj, :) = temp2(:, jj)/(eigenvalues(jj)+my_shift) + IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*0.0_dp + range3_eiv = range3_eiv+1 + ENDIF + ENDDO + ELSE + DO jj = 1, N + IF (eigenvalues(jj) .LT. range1_thr) THEN + temp1(jj, :) = temp2(:, jj)*0.0_dp + IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*1.0_dp + range1_eiv = range1_eiv+1 + ELSE + temp1(jj, :) = temp2(:, jj)/(eigenvalues(jj)+my_shift) + IF (PRESENT(bad_modes_projector_down)) temp3(jj, :) = Ainv(:, jj)*0.0_dp + range2_eiv = range2_eiv+1 + ENDIF + ENDDO + ENDIF ENDIF !WRITE(*,*) ' EIV RANGES: ', range1_eiv, range2_eiv, range3_eiv - ALLOCATE (testN(N, N)) - testN(:, :) = MATMUL(Ainv, test) - Ainv = testN - DEALLOCATE (test, testN) + IF (PRESENT(bad_modes_projector_down)) THEN + IF (PRESENT(s_half)) THEN + CALL DSYMM('L', 'U', N, N, 1.0_dp, s_half, N, temp2, N, 0.0_dp, Ainv, N) + CALL DSYMM('R', 'U', N, N, 1.0_dp, s_half, N, temp3, N, 0.0_dp, temp4, N) + CALL DGEMM('N', 'N', N, N, N, 1.0_dp, Ainv, N, temp4, N, 0.0_dp, bad_modes_projector_down, N) + ELSE + CALL DGEMM('N', 'N', N, N, N, 1.0_dp, temp2, N, temp3, N, 0.0_dp, bad_modes_projector_down, N) + ENDIF + ENDIF + + IF (PRESENT(s_inv_half)) THEN + CALL DSYMM('L', 'U', N, N, 1.0_dp, s_inv_half, N, temp2, N, 0.0_dp, temp4, N) + CALL DSYMM('R', 'U', N, N, 1.0_dp, s_inv_half, N, temp1, N, 0.0_dp, temp2, N) + CALL DGEMM('N', 'N', N, N, N, 1.0_dp, temp4, N, temp2, N, 0.0_dp, Ainv, N) + ELSE + CALL DGEMM('N', 'N', N, N, N, 1.0_dp, temp2, N, temp1, N, 0.0_dp, Ainv, N) + ENDIF + DEALLOCATE (temp1, temp2, temp4) + IF (PRESENT(bad_modes_projector_down)) DEALLOCATE (temp3) DEALLOCATE (eigenvalues) CASE DEFAULT @@ -2765,57 +2755,57 @@ CONTAINS END SELECT !! compute the inversion error - !allocate(test(N,N)) - !test=MATMUL(Ainv,A) + !allocate(temp1(N,N)) + !temp1=MATMUL(Ainv,A) !DO ii=1,N - ! test(ii,ii)=test(ii,ii)-1.0_dp + ! temp1(ii,ii)=temp1(ii,ii)-1.0_dp !ENDDO - !test_error=0.0_dp + !temp1_error=0.0_dp !DO ii=1,N ! DO jj=1,N - ! test_error=test_error+test(jj,ii)*test(jj,ii) + ! temp1_error=temp1_error+temp1(jj,ii)*temp1(jj,ii) ! ENDDO !ENDDO - !WRITE(*,*) "Inversion error: ", SQRT(test_error) - !deallocate(test) + !WRITE(*,*) "Inversion error: ", SQRT(temp1_error) + !deallocate(temp1) CALL timestop(handle) END SUBROUTINE pseudo_invert_matrix ! ************************************************************************************************** -!> \brief computes the step matrix from the gradient and Hessian using -!> the Newton-Raphson method -!> \param matrix_grad ... -!> \param matrix_step ... -!> \param matrix_s ... -!> \param matrix_ks ... -!> \param matrix_t ... -!> \param matrix_sigma_inv ... -!> \param quench_t ... -!> \param spin_factor ... -!> \param eps_filter ... +!> \brief Find matrix power using diagonalization +!> \param A ... +!> \param Apow ... +!> \param power ... +!> \param N ... +!> \param range1 ... +!> \param range1_thr ... +!> \param shift ... !> \par History -!> 2012.02 created [Rustam Z. Khaliullin] +!> 2012.04 created [Rustam Z. Khaliullin] !> \author Rustam Z. Khaliullin ! ************************************************************************************************** - SUBROUTINE newton_grad_to_step(matrix_grad, matrix_step, matrix_s, matrix_ks, & - matrix_t, matrix_sigma_inv, quench_t, spin_factor, eps_filter) - TYPE(dbcsr_type), INTENT(INOUT) :: matrix_grad, matrix_step, matrix_s - TYPE(dbcsr_type), INTENT(IN) :: matrix_ks, matrix_t - TYPE(dbcsr_type), INTENT(INOUT) :: matrix_sigma_inv, quench_t - REAL(KIND=dp), INTENT(IN) :: spin_factor, eps_filter + SUBROUTINE pseudo_matrix_power(A, Apow, power, N, range1, range1_thr, shift) - CHARACTER(len=*), PARAMETER :: routineN = 'newton_grad_to_step', & + REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: A + REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: Apow + REAL(KIND=dp), INTENT(IN) :: power + INTEGER, INTENT(IN) :: N + INTEGER, INTENT(IN), OPTIONAL :: range1 + REAL(KIND=dp), INTENT(IN), OPTIONAL :: range1_thr, shift + + CHARACTER(len=*), PARAMETER :: routineN = 'pseudo_matrix_power', & routineP = moduleN//':'//routineN - INTEGER :: handle, unit_nr - REAL(KIND=dp) :: res_norm + INTEGER :: handle, INFO, jj, LWORK, range1_eiv, & + range2_eiv, unit_nr + LOGICAL :: use_both, use_ranges, use_thr + REAL(KIND=dp) :: my_shift + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues, WORK + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: temp1, temp2 TYPE(cp_logger_type), POINTER :: logger - TYPE(dbcsr_type) :: m_tmp_no_1, m_tmp_no_3, m_tmp_oo_2, & - matrix_f_ao, matrix_f_mo, matrix_f_vo, & - matrix_s_ao, matrix_s_mo, matrix_s_vo CALL timeset(routineN, handle) @@ -2827,761 +2817,109 @@ CONTAINS unit_nr = -1 END IF - CALL dbcsr_create(matrix_s_ao, & - template=matrix_s, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(matrix_f_ao, & - template=matrix_s, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(matrix_f_mo, & - template=matrix_sigma_inv, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(matrix_s_mo, & - template=matrix_sigma_inv, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(matrix_f_vo, & - template=matrix_t) - CALL dbcsr_create(matrix_s_vo, & - template=matrix_t) - - CALL dbcsr_create(m_tmp_no_1, & - template=matrix_t) - CALL dbcsr_create(m_tmp_no_3, & - template=matrix_t) - CALL dbcsr_create(m_tmp_oo_2, & - template=matrix_sigma_inv, & - matrix_type=dbcsr_type_no_symmetry) - - ! calculate S-SRS and (1-R)F(1-R) - ! RZK-warning some optimization is ABSOLUTELY NECESSARY - CALL dbcsr_multiply("N", "N", 1.0_dp, & - matrix_s, & - matrix_t, & - 0.0_dp, m_tmp_no_1, & - filter_eps=eps_filter) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - m_tmp_no_1, & - matrix_sigma_inv, & - 0.0_dp, matrix_s_vo, & - filter_eps=eps_filter) - CALL dbcsr_desymmetrize(matrix_s, & - matrix_s_ao) - CALL dbcsr_multiply("N", "T", -1.0_dp, & - m_tmp_no_1, & - matrix_s_vo, & - 1.0_dp, matrix_s_ao, & - filter_eps=eps_filter) - - CALL dbcsr_multiply("N", "N", 1.0_dp, & - matrix_ks, & - matrix_t, & - 0.0_dp, m_tmp_no_1, & - filter_eps=eps_filter) - CALL dbcsr_desymmetrize(matrix_ks, matrix_f_ao) - CALL dbcsr_multiply("N", "T", -1.0_dp, & - m_tmp_no_1, & - matrix_s_vo, & - 1.0_dp, matrix_f_ao, & - filter_eps=eps_filter) - CALL dbcsr_multiply("N", "T", -1.0_dp, & - matrix_s_vo, & - m_tmp_no_1, & - 1.0_dp, matrix_f_ao, & - filter_eps=eps_filter) - CALL dbcsr_multiply("T", "N", 1.0_dp, & - matrix_t, & - m_tmp_no_1, & - 0.0_dp, matrix_f_mo, & - filter_eps=eps_filter) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - matrix_s_vo, & - matrix_f_mo, & - 0.0_dp, m_tmp_no_1, & - filter_eps=eps_filter) - CALL dbcsr_multiply("N", "T", 1.0_dp, & - m_tmp_no_1, & - matrix_s_vo, & - 1.0_dp, matrix_f_ao, & - filter_eps=eps_filter) - - ! calculate F_mo - CALL dbcsr_multiply("N", "N", 1.0_dp, & - matrix_sigma_inv, & - matrix_f_mo, & - 0.0_dp, m_tmp_oo_2, & - filter_eps=eps_filter) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - m_tmp_oo_2, & - matrix_sigma_inv, & - 1.0_dp, matrix_f_mo, & - filter_eps=eps_filter) - - ! calculate F_vo - CALL dbcsr_multiply("N", "N", 1.0_dp, & - matrix_ks, & - matrix_t, & - 0.0_dp, m_tmp_no_1, & - filter_eps=eps_filter) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - m_tmp_no_1, & - matrix_sigma_inv, & - 0.0_dp, matrix_f_vo, & - filter_eps=eps_filter) - CALL dbcsr_multiply("N", "T", -1.0_dp, & - matrix_s_vo, & - m_tmp_oo_2, & - 1.0_dp, matrix_f_vo, & - filter_eps=eps_filter) - - CALL dbcsr_desymmetrize(matrix_sigma_inv, matrix_s_mo) - - !!! RZK-warning: this is HIGHLIGHTED BLOCK - !!! check it first if the procedure does not function as it supposed to - !CALL dbcsr_desymmetrize(matrix_s,matrix_s_ao) - CALL dbcsr_add(matrix_f_ao, matrix_s_ao, 1.0_dp, 1.0_dp) - - CALL dbcsr_set(matrix_f_mo, 0.0_dp) - CALL dbcsr_add_on_diag(matrix_f_mo, 1.0_dp) - CALL dbcsr_filter(matrix_f_mo, eps_filter) - - CALL dbcsr_set(matrix_s_mo, 0.0_dp) - CALL dbcsr_add_on_diag(matrix_s_mo, 1.0_dp) - CALL dbcsr_filter(matrix_s_mo, eps_filter) - - CALL dbcsr_set(matrix_s_ao, 0.0_dp) - !CALL dbcsr_add_on_diag(matrix_s_ao,1.0_dp) - CALL dbcsr_filter(matrix_s_ao, eps_filter) - !!! RZK-warning: end of HIGHLIGHTED BLOCK - - CALL dbcsr_scale(matrix_f_ao, & - 2.0_dp*spin_factor) - CALL dbcsr_scale(matrix_s_ao, & - -2.0_dp*spin_factor) - CALL dbcsr_scale(matrix_f_vo, & - 2.0_dp*spin_factor) - - !WRITE(*,*) "INSIDE newton_grad_to_step: " - !CALL dbcsr_print(matrix_s_mo) - !CALL dbcsr_print(matrix_ks) - !CALL dbcsr_print(matrix_s) - !CALL dbcsr_print(matrix_sigma_inv) - - CALL hessian_diag_apply(matrix_grad, matrix_step, matrix_s_ao, & - matrix_f_ao, matrix_s_mo, matrix_f_mo, & - matrix_s_vo, matrix_f_vo, quench_t) - - ! check that the step satisfies H.step=-grad - CALL dbcsr_copy(m_tmp_no_3, quench_t) - CALL dbcsr_copy(m_tmp_no_1, quench_t) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - matrix_f_ao, & - matrix_step, & - 0.0_dp, m_tmp_no_1, & - !retain_sparsity=.TRUE.,& - filter_eps=eps_filter) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - m_tmp_no_1, & - matrix_s_mo, & - 0.0_dp, m_tmp_no_3, & - retain_sparsity=.TRUE., & - filter_eps=eps_filter) - CALL dbcsr_copy(m_tmp_no_1, quench_t) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - matrix_s_ao, & - matrix_step, & - 0.0_dp, m_tmp_no_1, & - !retain_sparsity=.TRUE.,& - filter_eps=eps_filter) - CALL dbcsr_multiply("N", "N", -1.0_dp, & - m_tmp_no_1, & - matrix_f_mo, & - 1.0_dp, m_tmp_no_3, & - retain_sparsity=.TRUE., & - filter_eps=eps_filter) - CALL dbcsr_add(m_tmp_no_3, matrix_grad, & - 1.0_dp, 1.0_dp) - CALL dbcsr_norm(m_tmp_no_3, & - dbcsr_norm_maxabsnorm, norm_scalar=res_norm) - IF (unit_nr > 0) WRITE (unit_nr, *) "NEWTON step error: ", res_norm - - CALL dbcsr_release(m_tmp_no_3) - CALL dbcsr_release(m_tmp_no_1) - CALL dbcsr_release(m_tmp_oo_2) - CALL dbcsr_release(matrix_s_ao) - CALL dbcsr_release(matrix_s_mo) - CALL dbcsr_release(matrix_f_ao) - CALL dbcsr_release(matrix_f_mo) - CALL dbcsr_release(matrix_s_vo) - CALL dbcsr_release(matrix_f_vo) - - CALL timestop(handle) - - END SUBROUTINE newton_grad_to_step - -! ************************************************************************************************** -!> \brief Serial code that constructs an approximate Hessian -!> \param matrix_grad ... -!> \param matrix_step ... -!> \param matrix_S_ao ... -!> \param matrix_F_ao ... -!> \param matrix_S_mo ... -!> \param matrix_F_mo ... -!> \param matrix_S_vo ... -!> \param matrix_F_vo ... -!> \param quench_t ... -!> \par History -!> 2012.02 created [Rustam Z. Khaliullin] -!> \author Rustam Z. Khaliullin -! ************************************************************************************************** - SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & - matrix_F_ao, matrix_S_mo, matrix_F_mo, matrix_S_vo, matrix_F_vo, quench_t) - - TYPE(dbcsr_type), INTENT(INOUT) :: matrix_grad, matrix_step, matrix_S_ao, & - matrix_F_ao, matrix_S_mo, matrix_F_mo, & - matrix_S_vo, matrix_F_vo, quench_t - - CHARACTER(len=*), PARAMETER :: routineN = 'hessian_diag_apply', & - routineP = moduleN//':'//routineN - - INTEGER :: ao_hori_offset, ao_vert_offset, block_col, block_row, col, copy, H_size, handle, & - ii, INFO, jj, lev1_hori_offset, lev1_vert_offset, lev2_hori_offset, lev2_vert_offset, & - LWORK, nblkcols_tot, nblkrows_tot, orb_i, orb_j, row, unit_nr, zero_neg_eiv - INTEGER, ALLOCATABLE, DIMENSION(:) :: ao_block_sizes, ao_domain_sizes, & - mo_block_sizes - INTEGER, DIMENSION(:), POINTER :: ao_blk_sizes, mo_blk_sizes - LOGICAL :: found, found2, found_col, found_row - REAL(KIND=dp) :: test_error - REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues, Grad_vec, Step_vec, tmp, & - tmpr, work - REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: F_ao_block, F_mo_block, H, H1, H2, Hinv, & - S_ao_block, S_mo_block, test, test2 - REAL(KIND=dp), DIMENSION(:, :), POINTER :: block_p, block_p2, p_new_block - TYPE(cp_logger_type), POINTER :: logger - TYPE(dbcsr_type) :: matrix_F_ao_sym, matrix_F_mo_sym, & - matrix_S_ao_sym, matrix_S_mo_sym - - CALL timeset(routineN, handle) - - ! get a useful unit_nr - logger => cp_get_default_logger() - IF (logger%para_env%mepos == logger%para_env%source) THEN - unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.) + IF (PRESENT(range1) .AND. PRESENT(range1_thr)) THEN + use_both = .TRUE. ELSE - unit_nr = -1 - END IF - - CALL dbcsr_get_info(quench_t, & - nblkrows_total=nblkrows_tot, & - nblkcols_total=nblkcols_tot, & - col_blk_size=mo_blk_sizes, & - row_blk_size=ao_blk_sizes) - - CPASSERT(nblkrows_tot == nblkcols_tot) - ALLOCATE (mo_block_sizes(nblkcols_tot), ao_block_sizes(nblkcols_tot)) - ALLOCATE (ao_domain_sizes(nblkcols_tot)) - mo_block_sizes(:) = mo_blk_sizes(:) - ao_block_sizes(:) = ao_blk_sizes(:) - ao_domain_sizes(:) = 0 - - CALL dbcsr_create(matrix_S_ao_sym, & - template=matrix_S_ao, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_desymmetrize(matrix_S_ao, matrix_S_ao_sym) - - CALL dbcsr_create(matrix_F_ao_sym, & - template=matrix_F_ao, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_desymmetrize(matrix_F_ao, matrix_F_ao_sym) - - CALL dbcsr_create(matrix_S_mo_sym, & - template=matrix_S_mo, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_desymmetrize(matrix_S_mo, matrix_S_mo_sym) - - CALL dbcsr_create(matrix_F_mo_sym, & - template=matrix_F_mo, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_desymmetrize(matrix_F_mo, matrix_F_mo_sym) - - !CALL dbcsr_print(matrix_grad) - !CALL dbcsr_print(matrix_F_ao_sym) - !CALL dbcsr_print(matrix_S_ao_sym) - !CALL dbcsr_print(matrix_F_mo_sym) - !CALL dbcsr_print(matrix_S_mo_sym) - - ! loop over domains to find the size of the Hessian - H_size = 0 - DO col = 1, nblkcols_tot - - ! find sizes of AO submatrices - DO row = 1, nblkrows_tot - - CALL dbcsr_get_block_p(quench_t, & - row, col, block_p, found) - IF (found) THEN - ao_domain_sizes(col) = ao_domain_sizes(col)+ao_blk_sizes(row) + use_both = .FALSE. + IF (PRESENT(range1)) THEN + use_ranges = .TRUE. + ELSE + use_ranges = .FALSE. + IF (PRESENT(range1_thr)) THEN + use_thr = .TRUE. + ELSE + use_thr = .FALSE. ENDIF + ENDIF + ENDIF - ENDDO + my_shift = 0.0_dp + IF (PRESENT(shift)) THEN + my_shift = shift + ENDIF - H_size = H_size+ao_domain_sizes(col)*mo_block_sizes(col) - - ENDDO - - ALLOCATE (H(H_size, H_size)) - - ! fill the Hessian matrix - lev1_vert_offset = 0 - ! loop over all pairs of fragments - DO row = 1, nblkcols_tot - - lev1_hori_offset = 0 - DO col = 1, nblkcols_tot - - ! prepare blocks for the current row-column fragment pair - ALLOCATE (F_ao_block(ao_domain_sizes(row), ao_domain_sizes(col))) - ALLOCATE (S_ao_block(ao_domain_sizes(row), ao_domain_sizes(col))) - ALLOCATE (F_mo_block(mo_block_sizes(row), mo_block_sizes(col))) - ALLOCATE (S_mo_block(mo_block_sizes(row), mo_block_sizes(col))) - - F_ao_block(:, :) = 0.0_dp - S_ao_block(:, :) = 0.0_dp - F_mo_block(:, :) = 0.0_dp - S_mo_block(:, :) = 0.0_dp - - ! fill AO submatrices - ! loop over all blocks of the AO dbcsr matrix - ao_vert_offset = 0 - DO block_row = 1, nblkcols_tot - - CALL dbcsr_get_block_p(quench_t, & - block_row, row, block_p, found_row) - IF (found_row) THEN - - ao_hori_offset = 0 - DO block_col = 1, nblkcols_tot - - CALL dbcsr_get_block_p(quench_t, & - block_col, col, block_p, found_col) - IF (found_col) THEN - - CALL dbcsr_get_block_p(matrix_F_ao_sym, & - block_row, block_col, block_p, found) - IF (found) THEN - ! copy the block into the submatrix - F_ao_block(ao_vert_offset+1:ao_vert_offset+ao_block_sizes(block_row), & - ao_hori_offset+1:ao_hori_offset+ao_block_sizes(block_col)) & - = block_p(:, :) - ENDIF - - CALL dbcsr_get_block_p(matrix_S_ao_sym, & - block_row, block_col, block_p, found) - IF (found) THEN - ! copy the block into the submatrix - S_ao_block(ao_vert_offset+1:ao_vert_offset+ao_block_sizes(block_row), & - ao_hori_offset+1:ao_hori_offset+ao_block_sizes(block_col)) & - = block_p(:, :) - ENDIF - - ao_hori_offset = ao_hori_offset+ao_block_sizes(block_col) - - ENDIF - - ENDDO - - ao_vert_offset = ao_vert_offset+ao_block_sizes(block_row) - - ENDIF - - ENDDO - - ! fill MO submatrices - CALL dbcsr_get_block_p(matrix_F_mo_sym, row, col, block_p, found) - IF (found) THEN - ! copy the block into the submatrix - F_mo_block(1:mo_block_sizes(row), 1:mo_block_sizes(col)) = block_p(:, :) - ENDIF - CALL dbcsr_get_block_p(matrix_S_mo_sym, row, col, block_p, found) - IF (found) THEN - ! copy the block into the submatrix - S_mo_block(1:mo_block_sizes(row), 1:mo_block_sizes(col)) = block_p(:, :) - ENDIF - - !WRITE(*,*) "F_AO_BLOCK", row, col, ao_domain_sizes(row), ao_domain_sizes(col) - !DO ii=1,ao_domain_sizes(row) - ! WRITE(*,'(100F13.9)') F_ao_block(ii,:) - !ENDDO - !WRITE(*,*) "S_AO_BLOCK", row, col - !DO ii=1,ao_domain_sizes(row) - ! WRITE(*,'(100F13.9)') S_ao_block(ii,:) - !ENDDO - !WRITE(*,*) "F_MO_BLOCK", row, col - !DO ii=1,mo_block_sizes(row) - ! WRITE(*,'(100F13.9)') F_mo_block(ii,:) - !ENDDO - !WRITE(*,*) "S_MO_BLOCK", row, col, mo_block_sizes(row), mo_block_sizes(col) - !DO ii=1,mo_block_sizes(row) - ! WRITE(*,'(100F13.9)') S_mo_block(ii,:) - !ENDDO - - ! construct tensor products for the current row-column fragment pair - lev2_vert_offset = 0 - DO orb_j = 1, mo_block_sizes(row) - - lev2_hori_offset = 0 - DO orb_i = 1, mo_block_sizes(col) - - H(lev1_vert_offset+lev2_vert_offset+1:lev1_vert_offset+lev2_vert_offset+ao_domain_sizes(row), & - lev1_hori_offset+lev2_hori_offset+1:lev1_hori_offset+lev2_hori_offset+ao_domain_sizes(col)) & - = S_mo_block(orb_j, orb_i)*F_ao_block(:, :) & - -F_mo_block(orb_j, orb_i)*S_ao_block(:, :) - - !WRITE(*,*) row, col, orb_j, orb_i, lev1_vert_offset+lev2_vert_offset+1, ao_domain_sizes(row),& - ! lev1_hori_offset+lev2_hori_offset+1, ao_domain_sizes(col), S_mo_block(orb_j,orb_i) - - lev2_hori_offset = lev2_hori_offset+ao_domain_sizes(col) - - ENDDO - - lev2_vert_offset = lev2_vert_offset+ao_domain_sizes(row) - - ENDDO - - lev1_hori_offset = lev1_hori_offset+ao_domain_sizes(col)*mo_block_sizes(col) - - DEALLOCATE (F_ao_block) - DEALLOCATE (S_ao_block) - DEALLOCATE (F_mo_block) - DEALLOCATE (S_mo_block) - - ENDDO ! col fragment - - lev1_vert_offset = lev1_vert_offset+ao_domain_sizes(row)*mo_block_sizes(row) - - ENDDO ! row fragment - - CALL dbcsr_release(matrix_S_ao_sym) - CALL dbcsr_release(matrix_F_ao_sym) - CALL dbcsr_release(matrix_S_mo_sym) - CALL dbcsr_release(matrix_F_mo_sym) - - ! two more terms of the Hessian - ALLOCATE (H1(H_size, H_size)) - ALLOCATE (H2(H_size, H_size)) - H1 = 0.0_dp - H2 = 0.0_dp - DO row = 1, nblkcols_tot - - lev1_hori_offset = 0 - DO col = 1, nblkcols_tot - - CALL dbcsr_get_block_p(matrix_F_vo, & - row, col, block_p, found) - CALL dbcsr_get_block_p(matrix_S_vo, & - row, col, block_p2, found2) - - lev1_vert_offset = 0 - DO block_col = 1, nblkcols_tot - - CALL dbcsr_get_block_p(quench_t, & - row, block_col, p_new_block, found_row) - - IF (found_row) THEN - - ! determine offset in this short loop - lev2_vert_offset = 0 - DO block_row = 1, row-1 - CALL dbcsr_get_block_p(quench_t, & - block_row, block_col, p_new_block, found_col) - IF (found_col) lev2_vert_offset = lev2_vert_offset+ao_block_sizes(block_row) - ENDDO - !!!!!!!! short loop - - ! over all electrons of the block - DO orb_i = 1, mo_block_sizes(col) - - ! into all possible locations - DO orb_j = 1, mo_block_sizes(block_col) - - ! column is copied several times - DO copy = 1, ao_domain_sizes(col) - - IF (found) THEN - - !WRITE(*,*) row, col, block_col, orb_i, orb_j, copy,& - ! lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+1,& - ! lev1_hori_offset+(orb_i-1)*ao_domain_sizes(col)+copy - - H1(lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+1: & - lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+ao_block_sizes(row), & - lev1_hori_offset+(orb_i-1)*ao_domain_sizes(col)+copy) & - = block_p(:, orb_i) - - ENDIF ! found block in the data matrix - - IF (found2) THEN - - H2(lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+1: & - lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+ao_block_sizes(row), & - lev1_hori_offset+(orb_i-1)*ao_domain_sizes(col)+copy) & - = block_p2(:, orb_i) - - ENDIF ! found block in the data matrix - - ENDDO - - ENDDO - - ENDDO - - !lev2_vert_offset=lev2_vert_offset+ao_block_sizes(row) - - ENDIF ! found block in the quench matrix - - lev1_vert_offset = lev1_vert_offset+ & - ao_domain_sizes(block_col)*mo_block_sizes(block_col) - - ENDDO - - lev1_hori_offset = lev1_hori_offset+ & - ao_domain_sizes(col)*mo_block_sizes(col) - - ENDDO - - !lev2_vert_offset=lev2_vert_offset+ao_block_sizes(row) - - ENDDO - ! add terms to the hessian -!WRITE(*,*) "F_vo" -!DO ii=1,H_size -! WRITE(*,'(100F13.9)') H1(ii,:) -!ENDDO -!WRITE(*,*) "S_vo" -!DO ii=1,H_size -! WRITE(*,'(100F13.9)') H2(ii,:) -!ENDDO - !DO ii=1,H_size - ! DO jj=1,H_size - ! H(ii,jj)=H(ii,jj)-H1(ii,jj)*H2(jj,ii)-H1(jj,ii)*H2(ii,jj) - ! ENDDO - !ENDDO - DEALLOCATE (H1) - DEALLOCATE (H2) - - ! convert gradient from the dbcsr matrix to the vector form - ALLOCATE (Grad_vec(H_size)) - Grad_vec(:) = 0.0_dp - lev1_vert_offset = 0 - ! loop over all electron blocks - DO col = 1, nblkcols_tot - - ! loop over AO-rows of the dbcsr matrix - lev2_vert_offset = 0 - DO row = 1, nblkrows_tot - - CALL dbcsr_get_block_p(quench_t, & - row, col, block_p, found_row) - IF (found_row) THEN - - CALL dbcsr_get_block_p(matrix_grad, & - row, col, block_p, found) - IF (found) THEN - ! copy the data into the vector, column by column - DO orb_i = 1, mo_block_sizes(col) - Grad_vec(lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1: & - lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+ao_block_sizes(row)) & - = block_p(:, orb_i) -!WRITE(*,*) "GRAD: ", row, col, orb_i, lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1, ao_block_sizes(row) - ENDDO - - ENDIF - - lev2_vert_offset = lev2_vert_offset+ao_block_sizes(row) - - ENDIF - - ENDDO - - lev1_vert_offset = lev1_vert_offset+ao_domain_sizes(col)*mo_block_sizes(col) - - ENDDO ! loop over electron blocks - -!WRITE(*,*) "HESSIAN" -!DO ii=1,H_size -! WRITE(*,'(100F13.9)') H(ii,:) -!ENDDO - - ! invert the Hessian + Apow = A INFO = 0 - ALLOCATE (Hinv(H_size, H_size)) - Hinv(:, :) = H(:, :) - ! before inverting diagonalize - ALLOCATE (eigenvalues(H_size)) + ! diagonalize first + ALLOCATE (eigenvalues(N)) + ALLOCATE (temp1(N, N)) + ! Query the optimal workspace for dsyev LWORK = -1 ALLOCATE (WORK(MAX(1, LWORK))) - CALL DSYEV('V', 'L', H_size, Hinv, H_size, eigenvalues, WORK, LWORK, INFO) + CALL DSYEV('V', 'L', N, Apow, N, eigenvalues, WORK, LWORK, INFO) + LWORK = INT(WORK(1)) DEALLOCATE (WORK) ! Allocate the workspace and solve the eigenproblem ALLOCATE (WORK(MAX(1, LWORK))) - CALL DSYEV('V', 'L', H_size, Hinv, H_size, eigenvalues, WORK, LWORK, INFO) + + CALL DSYEV('V', 'L', N, Apow, N, eigenvalues, WORK, LWORK, INFO) + IF (INFO .NE. 0) THEN - IF (unit_nr > 0) WRITE (unit_nr, *) 'DSYEV ERROR MESSAGE: ', INFO - CPABORT("DSYEV failed") + IF (unit_nr > 0) WRITE (unit_nr, *) 'EIGENSYSTEM ERROR MESSAGE: ', INFO + CPABORT("Eigenproblem routine failed") END IF DEALLOCATE (WORK) - ! invert eigenvalues and use eigenvectors to compute the Hessian inverse - ! project out zero-eigenvalue directions - ALLOCATE (test(H_size, H_size)) - zero_neg_eiv = 0 - DO jj = 1, H_size - IF (eigenvalues(jj) .GT. 1.0E-8) THEN - test(jj, :) = Hinv(:, jj)/eigenvalues(jj) - ELSE - test(jj, :) = Hinv(:, jj)*0.0_dp - zero_neg_eiv = zero_neg_eiv+1 - ENDIF - ENDDO - IF (unit_nr > 0) WRITE (unit_nr, *) 'ZERO OR NEGATIVE EIGENVALUES: ', zero_neg_eiv - ALLOCATE (test2(H_size, H_size)) - test2(:, :) = MATMUL(Hinv, test) - Hinv(:, :) = test2(:, :) - DEALLOCATE (test, test2) + !WRITE(*,*) "EIGENVALS: " + !WRITE(*,'(4F13.9)') eigenvalues(:) - !! shift to kill singularity - !shift=0.0_dp - !IF (eigenvalues(1).lt.0.0_dp) THEN - ! CPErrorMessage(cp_failure_level,routineP,"Negative eigenvalue(s)") - ! shift=abs(eigenvalues(1)) - ! WRITE(*,*) "Lowest eigenvalue: ", eigenvalues(1) - !ENDIF - !DO ii=1, H_size - ! IF (eigenvalues(ii).gt.1.0E-6_dp) THEN - ! shift=shift+min(1.0_dp,eigenvalues(ii))*1.0E-4_dp - ! EXIT - ! ENDIF - !ENDDO - !WRITE(*,*) "Hessian shift: ", shift - !DO ii=1, H_size - ! H(ii,ii)=H(ii,ii)+shift - !ENDDO - !! end shift + ! invert eigenvalues and use eigenvectors to compute pseudo Ainv + ! project out near-zero eigenvalue modes + ALLOCATE (temp2(N, N)) - DEALLOCATE (eigenvalues) + temp2(1:N, 1:N) = Apow(1:N, 1:N) -!!!! Hinv=H -!!!! INFO=0 -!!!! CALL DPOTRF('L', H_size, Hinv, H_size, INFO ) -!!!! IF( INFO.NE.0 ) THEN -!!!! WRITE(*,*) 'DPOTRF ERROR MESSAGE: ', INFO -!!!! CPErrorMessage(cp_failure_level,routineP,"DPOTRF failed") -!!!! CPPrecondition(.FALSE.,cp_failure_level,routineP,failure) -!!!! END IF -!!!! CALL DPOTRI('L', H_size, Hinv, H_size, INFO ) -!!!! IF( INFO.NE.0 ) THEN -!!!! WRITE(*,*) 'DPOTRI ERROR MESSAGE: ', INFO -!!!! CPErrorMessage(cp_failure_level,routineP,"DPOTRI failed") -!!!! CPPrecondition(.FALSE.,cp_failure_level,routineP,failure) -!!!! END IF -!!!! ! complete the matrix -!!!! DO ii=1,H_size -!!!! DO jj=ii+1,H_size -!!!! Hinv(ii,jj)=Hinv(jj,ii) -!!!! ENDDO -!!!! ENDDO - - ! compute the inversion error - ALLOCATE (test(H_size, H_size)) -! WRITE(*,*) "SIZE: ", H_size - test(:, :) = MATMUL(Hinv, H) -!WRITE(*,*) "TEST" -!DO ii=1,H_size -! WRITE(*,'(100F8.4)') test(ii,:) -!ENDDO - DO ii = 1, H_size - test(ii, ii) = test(ii, ii)-1.0_dp - ENDDO - test_error = 0.0_dp - DO ii = 1, H_size - DO jj = 1, H_size - test_error = test_error+test(jj, ii)*test(jj, ii) - ENDDO - ENDDO - IF (unit_nr > 0) WRITE (unit_nr, *) "Hessian inversion error: ", SQRT(test_error) - DEALLOCATE (test) - - ! prepare the output vector - ALLOCATE (Step_vec(H_size)) - ALLOCATE (tmp(H_size)) - tmp(:) = MATMUL(Hinv, Grad_vec) - Step_vec(:) = -1.0_dp*tmp(:) - - ALLOCATE (tmpr(H_size)) - tmpr(:) = MATMUL(H, Step_vec) - tmp(:) = tmpr(:)+Grad_vec(:) - DEALLOCATE (tmpr) - IF (unit_nr > 0) WRITE (unit_nr, *) "NEWTOV step error: ", MAXVAL(ABS(tmp)) - - DEALLOCATE (tmp) - - DEALLOCATE (H) - DEALLOCATE (Hinv) - DEALLOCATE (Grad_vec) - - ! copy the step from the vector into the cp_dbcsr matrix - - ! re-create the step matrix to remove all blocks - CALL dbcsr_create(matrix_step, & - template=matrix_grad, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_work_create(matrix_step, work_mutable=.TRUE.) - - lev1_vert_offset = 0 - ! loop over all electron blocks - DO col = 1, nblkcols_tot - - ! loop over AO-rows of the dbcsr matrix - lev2_vert_offset = 0 - DO row = 1, nblkrows_tot - - CALL dbcsr_get_block_p(quench_t, & - row, col, block_p, found_row) - IF (found_row) THEN - - NULLIFY (p_new_block) - CALL dbcsr_reserve_block2d(matrix_step, row, col, p_new_block) - CPASSERT(ASSOCIATED(p_new_block)) - ! copy the data column by column - DO orb_i = 1, mo_block_sizes(col) - p_new_block(:, orb_i) = & - Step_vec(lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1: & - lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+ao_block_sizes(row)) -!WRITE(*,*) "STEP: ", row, col, orb_i, lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1, ao_block_sizes(row) - ENDDO - - lev2_vert_offset = lev2_vert_offset+ao_block_sizes(row) + range1_eiv = 0 + range2_eiv = 0 + IF (use_both) THEN + DO jj = 1, N + IF ((jj .LE. range1) .AND. (eigenvalues(jj) .LT. range1_thr)) THEN + temp1(jj, :) = temp2(:, jj)*0.0_dp + range1_eiv = range1_eiv+1 + ELSE + temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj)+my_shift)**power) ENDIF - ENDDO + ELSE + IF (use_ranges) THEN + DO jj = 1, N + IF (jj .LE. range1) THEN + temp1(jj, :) = temp2(:, jj)*0.0_dp + range1_eiv = range1_eiv+1 + ELSE + temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj)+my_shift)**power) + ENDIF + ENDDO + ELSE + IF (use_thr) THEN + DO jj = 1, N + IF (eigenvalues(jj) .LT. range1_thr) THEN + temp1(jj, :) = temp2(:, jj)*0.0_dp - lev1_vert_offset = lev1_vert_offset+ao_domain_sizes(col)*mo_block_sizes(col) - - ENDDO ! loop over electron blocks - - DEALLOCATE (Step_vec) - - CALL dbcsr_finalize(matrix_step) - - DEALLOCATE (mo_block_sizes, ao_block_sizes) - DEALLOCATE (ao_domain_sizes) + range1_eiv = range1_eiv+1 + ELSE + temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj)+my_shift)**power) + ENDIF + ENDDO + ELSE + DO jj = 1, N + temp1(jj, :) = temp2(:, jj)*((eigenvalues(jj)+my_shift)**power) + ENDDO + ENDIF + ENDIF + ENDIF + !WRITE(*,*) ' EIV RANGES: ', range1_eiv, range2_eiv, range3_eiv + Apow = MATMUL(temp2, temp1) + DEALLOCATE (temp1, temp2) + DEALLOCATE (eigenvalues) CALL timestop(handle) - END SUBROUTINE hessian_diag_apply + END SUBROUTINE pseudo_matrix_power ! ************************************************************************************************** !> \brief Load balancing of the submatrix computations @@ -3708,6 +3046,7 @@ CONTAINS !> \param order_lanczos ... !> \param eps_lanczos ... !> \param max_iter_lanczos ... +!> \param nocc_of_domain ... !> \par History !> 2016.11 created [Rustam Z Khaliullin] !> \author Rustam Z Khaliullin @@ -3715,7 +3054,7 @@ CONTAINS SUBROUTINE 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) + max_iter_lanczos, nocc_of_domain) TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_guess TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_t_in, m_t0, m_quench_t @@ -3728,6 +3067,7 @@ CONTAINS INTEGER, INTENT(IN) :: order_lanczos REAL(KIND=dp), INTENT(IN) :: eps_lanczos INTEGER, INTENT(IN) :: max_iter_lanczos + INTEGER, DIMENSION(:, :), INTENT(IN) :: nocc_of_domain CHARACTER(len=*), PARAMETER :: routineN = 'xalmo_initial_guess', & routineP = moduleN//':'//routineN @@ -3794,6 +3134,8 @@ CONTAINS CALL dbcsr_create(m_extrapolated, & template=m_quench_t(ispin), matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_sigma_tmp, & + template=m_sigma_tmpl(ispin), matrix_type=dbcsr_type_no_symmetry) ! set to zero before accumulation CALL dbcsr_set(m_guess(ispin), 0.0_dp) @@ -3814,14 +3156,27 @@ CONTAINS CALL dbcsr_copy(m_extrapolated, m_quench_t(ispin)) ! project t0 onto the previous DMs - ! note that t0 is projected instead of anything else - ! this is done to keep orbitals phase (i.e. sign) the same - ! if this is not done the extrapolation will fail + ! note that t0 is projected instead of any other matrix (e.g. + ! t_SCF from the prev step or random t) + ! this is done to keep orbitals phase (i.e. sign) the same as in + ! t0. if this is not done then subtracting t0 on the next step + ! will produce a terrible guess and extrapolation will fail CALL dbcsr_multiply("N", "N", 1.0_dp, & xalmo_history%matrix_p_up_down(ispin, istore), & m_t0(ispin), & 0.0_dp, m_extrapolated, & retain_sparsity=.TRUE.) + ! normalize MOs + CALL orthogonalize_mos(ket=m_extrapolated, & + overlap=m_sigma_tmp, & + metric=m_overlap, & + retain_locality=.TRUE., & + only_normalize=.FALSE., & + nocc_of_domain=nocc_of_domain(:, ispin), & + eps_filter=eps_filter, & + order_lanczos=order_lanczos, & + eps_lanczos=eps_lanczos, & + max_iter_lanczos=max_iter_lanczos) ! now accumulate. correct sparsity is ensured CALL dbcsr_add(m_guess(ispin), m_extrapolated, & @@ -3832,14 +3187,12 @@ CONTAINS CALL dbcsr_release(m_extrapolated) ! normalize MOs - CALL dbcsr_create(m_sigma_tmp, & - template=m_sigma_tmpl(ispin), matrix_type=dbcsr_type_no_symmetry) - CALL orthogonalize_mos(ket=m_guess(ispin), & overlap=m_sigma_tmp, & metric=m_overlap, & retain_locality=.TRUE., & only_normalize=.FALSE., & + nocc_of_domain=nocc_of_domain(:, ispin), & eps_filter=eps_filter, & order_lanczos=order_lanczos, & eps_lanczos=eps_lanczos, & @@ -3852,98 +3205,6 @@ CONTAINS IF (assume_t0_q0x) THEN CALL dbcsr_add(m_guess(ispin), m_t0(ispin), & 1.0_dp, -1.0_dp) - - !! multiply by the pseudo-inverse of (S-RSR) - !! this part was brought from outside and was never adapted - !! perhaps it is not important and can be deleted later - !IF (my_special_case .EQ. xalmo_case_fully_deloc) THEN - - ! CALL dbcsr_init(m_tmp_no_1) - ! CALL dbcsr_init(m_tmp_nn_1) - ! CALL dbcsr_init(prec_vv) - ! CALL dbcsr_init(ST) - ! CALL dbcsr_create(ST, & - ! template=matrix_t_out(ispin), & - ! matrix_type=dbcsr_type_no_symmetry) - ! CALL dbcsr_create(m_tmp_no_1, & - ! template=matrix_t_out(ispin), & - ! matrix_type=dbcsr_type_no_symmetry) - ! CALL dbcsr_create(m_tmp_nn_1, & - ! template=almo_scf_env%matrix_s(1), & - ! matrix_type=dbcsr_type_no_symmetry) - ! CALL dbcsr_create(prec_vv, & - ! template=almo_scf_env%matrix_s(1), & - ! matrix_type=dbcsr_type_no_symmetry) - ! ! First S-SRS - ! CALL dbcsr_multiply("N","N",1.0_dp,& - ! almo_scf_env%matrix_s(1),& - ! almo_scf_env%matrix_t_blk(ispin),& - ! 0.0_dp,ST,& - ! filter_eps=almo_scf_env%eps_filter) - ! CALL dbcsr_multiply("N", "N", 1.0_dp, & - ! ST, & - ! almo_scf_env%matrix_sigma_inv_0deloc(ispin), & - ! 0.0_dp, m_tmp_no_1, & - ! filter_eps=almo_scf_env%eps_filter) - ! CALL dbcsr_desymmetrize(almo_scf_env%matrix_s(1), & - ! m_tmp_nn_1) - ! CALL dbcsr_multiply("N", "T", -1.0_dp, & - ! ST, & - ! m_tmp_no_1, & - ! 1.0_dp, m_tmp_nn_1, & - ! filter_eps=almo_scf_env%eps_filter) - - ! ! pseudo-invert the virtual projector - ! CALL dbcsr_get_info(m_tmp_nn_1, nfullrows_total=dim0) - ! ALLOCATE (evals(dim0)) - ! CALL cp_dbcsr_syevd(m_tmp_nn_1, prec_vv, evals, & - ! almo_scf_env%para_env, almo_scf_env%blacs_env) - ! ! invert eigenvalues and use eigenvectors to compute the pseudo-inverse - ! zero_neg_eiv = 0 - ! CALL dbcsr_get_info(almo_scf_env%matrix_sigma_inv_0deloc(ispin), nfullrows_total=occ1) - ! DO jj = 1, dim0 - ! IF (jj .LE. occ1) THEN - ! zero_neg_eiv = zero_neg_eiv+1 - ! evals(jj) = evals(jj)*0.0_dp - ! ELSE - ! evals(jj) = 1.0_dp/evals(jj) - ! ENDIF - ! ENDDO - ! IF (unit_nr > 0) THEN - ! WRITE (*, *) 'ZERO OR NEGATIVE EIGENVALUES: ', zero_neg_eiv, SUM(evals(1:zero_neg_eiv)) - ! ENDIF - ! CALL dbcsr_init(inv_eiv) - ! CALL dbcsr_create(inv_eiv, & - ! template=m_tmp_nn_1, & - ! matrix_type=dbcsr_type_no_symmetry) - ! CALL dbcsr_add_on_diag(inv_eiv, 1.0_dp) - ! CALL dbcsr_set_diag(inv_eiv, evals) - ! CALL dbcsr_multiply("N", "N", 1.0_dp, & - ! prec_vv, & - ! inv_eiv, & - ! 0.0_dp, m_tmp_nn_1, & - ! filter_eps=almo_scf_env%eps_filter) - ! CALL dbcsr_multiply("N", "T", 1.0_dp, & - ! m_tmp_nn_1, & - ! prec_vv, & - ! 0.0_dp, inv_eiv, & - ! filter_eps=almo_scf_env%eps_filter) - ! CALL dbcsr_multiply("N", "N", 1.0_dp, & - ! inv_eiv, & - ! m_theta(ispin), & - ! 0.0_dp, m_tmp_no_1, & - ! filter_eps=almo_scf_env%eps_filter) - ! CALL dbcsr_copy(m_theta(ispin),m_tmp_no_1) - - ! CALL dbcsr_release(inv_eiv) - ! CALL dbcsr_release(m_tmp_no_1) - ! CALL dbcsr_release(m_tmp_nn_1) - ! CALL dbcsr_release(prec_vv) - ! CALL dbcsr_release(ST) - ! DEALLOCATE (evals) - - !ENDIF !special_case - ENDIF !assume_t0_q0x ENDDO !ispin diff --git a/src/almo_scf_optimizer.F b/src/almo_scf_optimizer.F index 94e0d84fac..96e1d13dab 100644 --- a/src/almo_scf_optimizer.F +++ b/src/almo_scf_optimizer.F @@ -18,26 +18,26 @@ MODULE almo_scf_optimizer almo_scf_diis_type USE almo_scf_methods, ONLY: & almo_scf_ks_blk_to_tv_blk, almo_scf_ks_to_ks_blk, almo_scf_ks_to_ks_xx, & - almo_scf_ks_xx_to_tv_xx, almo_scf_p_blk_to_t_blk, almo_scf_t_blk_to_p, & - almo_scf_t_blk_to_t_blk_orthonormal, almo_scf_t_to_p, apply_domain_operators, & - apply_projector, construct_domain_preconditioner, construct_domain_r_down, & - construct_domain_s_inv, construct_domain_s_sqrt, get_overlap, newton_grad_to_step, & - pseudo_invert_diagonal_blk, xalmo_initial_guess - USE almo_scf_qs, ONLY: almo_scf_dm_to_ks,& - almo_scf_update_ks_energy,& - matrix_qs_to_almo + almo_scf_ks_xx_to_tv_xx, almo_scf_p_blk_to_t_blk, almo_scf_t_to_proj, & + apply_domain_operators, apply_projector, construct_domain_preconditioner, & + construct_domain_r_down, construct_domain_s_inv, construct_domain_s_sqrt, get_overlap, & + orthogonalize_mos, pseudo_invert_diagonal_blk, xalmo_initial_guess + USE almo_scf_qs, ONLY: almo_dm_to_almo_ks,& + almo_dm_to_qs_env,& + almo_scf_update_ks_energy USE almo_scf_types, ONLY: almo_scf_env_type,& optimizer_options_type + USE cp_blacs_env, ONLY: cp_blacs_env_type USE cp_dbcsr_cholesky, ONLY: cp_dbcsr_cholesky_decompose,& cp_dbcsr_cholesky_invert,& cp_dbcsr_cholesky_restore - USE cp_dbcsr_diag, ONLY: cp_dbcsr_syevd USE cp_external_control, ONLY: external_control USE cp_log_handling, ONLY: cp_get_default_logger,& cp_logger_get_default_unit_nr,& cp_logger_type USE cp_output_handling, ONLY: cp_print_key_finished_output,& cp_print_key_unit_nr + USE cp_para_types, ONLY: cp_para_env_type USE ct_methods, ONLY: analytic_line_search,& ct_step_execute,& diagonalize_diagonal_blocks @@ -50,12 +50,13 @@ MODULE almo_scf_optimizer dbcsr_add, dbcsr_add_on_diag, dbcsr_copy, dbcsr_create, dbcsr_desymmetrize, & dbcsr_distribution_get, dbcsr_distribution_type, dbcsr_filter, dbcsr_finalize, & dbcsr_frobenius_norm, dbcsr_func_dtanh, dbcsr_func_inverse, dbcsr_func_tanh, & - dbcsr_function_of_elements, dbcsr_get_diag, dbcsr_get_info, dbcsr_hadamard_product, & - dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, dbcsr_iterator_start, & - dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_multiply, dbcsr_norm, & - dbcsr_norm_maxabsnorm, dbcsr_p_type, dbcsr_print_block_sum, dbcsr_release, & - dbcsr_reserve_block2d, dbcsr_scale, dbcsr_set, dbcsr_set_diag, dbcsr_trace, dbcsr_triu, & - dbcsr_type, dbcsr_type_no_symmetry, dbcsr_work_create + dbcsr_function_of_elements, dbcsr_get_block_p, dbcsr_get_diag, dbcsr_get_info, & + dbcsr_hadamard_product, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, & + dbcsr_iterator_start, dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_multiply, & + dbcsr_nblkcols_total, dbcsr_nblkrows_total, dbcsr_norm, dbcsr_norm_maxabsnorm, & + dbcsr_p_type, dbcsr_print_block_sum, dbcsr_release, dbcsr_reserve_block2d, dbcsr_scale, & + dbcsr_set, dbcsr_set_diag, dbcsr_trace, dbcsr_triu, dbcsr_type, dbcsr_type_no_symmetry, & + dbcsr_work_create USE domain_submatrix_methods, ONLY: add_submatrices,& construct_submatrices,& copy_submatrices,& @@ -66,16 +67,19 @@ MODULE almo_scf_optimizer domain_submatrix_type,& select_row USE input_constants, ONLY: & - almo_scf_diag, almo_scf_dm_sign, cg_dai_yuan, cg_fletcher, cg_fletcher_reeves, & - cg_hager_zhang, cg_hestenes_stiefel, cg_liu_storey, cg_polak_ribiere, cg_zero, prec_zero, & - virt_full, xalmo_case_block_diag, xalmo_case_fully_deloc, xalmo_case_normal + almo_occ_vol_penalty_none, almo_scf_diag, almo_scf_dm_sign, cg_dai_yuan, cg_fletcher, & + cg_fletcher_reeves, cg_hager_zhang, cg_hestenes_stiefel, cg_liu_storey, cg_polak_ribiere, & + cg_zero, virt_full, xalmo_case_block_diag, xalmo_case_fully_deloc, xalmo_case_normal, & + xalmo_prec_domain, xalmo_prec_full, xalmo_prec_zero USE input_section_types, ONLY: section_vals_get_subs_vals,& section_vals_type - USE iterate_matrix, ONLY: invert_Hotelling,& + USE iterate_matrix, ONLY: determinant,& + invert_Hotelling,& matrix_sqrt_Newton_Schulz USE kinds, ONLY: dp USE machine, ONLY: m_flush,& m_walltime + USE qs_energy_types, ONLY: qs_energy_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type #include "./base/base_uses.f90" @@ -92,6 +96,9 @@ MODULE almo_scf_optimizer LOGICAL, PARAMETER :: debug_mode = .FALSE. LOGICAL, PARAMETER :: safe_mode = .FALSE. + LOGICAL, PARAMETER :: almo_mathematica = .FALSE. + INTEGER, PARAMETER :: hessian_path_reuse = 1, & + hessian_path_assemble = 2 CONTAINS @@ -112,8 +119,7 @@ CONTAINS CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_block_diagonal', & routineP = moduleN//':'//routineN - INTEGER :: handle, iscf, ispin, nspin, nstrikes, & - ntolerate, unit_nr + INTEGER :: handle, iscf, ispin, nspin, unit_nr INTEGER, ALLOCATABLE, DIMENSION(:) :: local_nocc_of_domain LOGICAL :: converged, prepare_to_exit, should_stop, & use_diis, use_prev_as_guess @@ -125,8 +131,10 @@ CONTAINS TYPE(almo_scf_diis_type), ALLOCATABLE, & DIMENSION(:) :: almo_diis TYPE(cp_logger_type), POINTER :: logger - TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: matrix_mixing_old_blk + TYPE(qs_energy_type), POINTER :: qs_energy + +!TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks CALL timeset(routineN, handle) @@ -159,13 +167,12 @@ CONTAINS max_length=optimizer%ndiis) ENDDO - energy_old = 0.0_dp + CALL get_qs_env(qs_env, energy=qs_energy) + energy_old = qs_energy%total + iscf = 0 prepare_to_exit = .FALSE. true_mixing_fraction = 0.0_dp - ! set variables that control diag/pcg switching - nstrikes = 0 - ntolerate = 3 error_norm = 1.0E+10_dp ! arbitrary big step IF (unit_nr > 0) THEN @@ -183,19 +190,6 @@ CONTAINS iscf = iscf+1 - ! get a copy of the current KS matrix - CALL get_qs_env(qs_env, matrix_ks=matrix_ks) - DO ispin = 1, nspin - CALL matrix_qs_to_almo(matrix_ks(ispin)%matrix, & - almo_scf_env%matrix_ks(ispin), & - almo_scf_env, .FALSE.) - CALL matrix_qs_to_almo(matrix_ks(ispin)%matrix, & - almo_scf_env%matrix_ks_blk(ispin), & - almo_scf_env, .TRUE.) - CALL dbcsr_filter(almo_scf_env%matrix_ks(ispin), & - almo_scf_env%eps_filter) - ENDDO - ! obtain projected KS matrix and the DIIS-error vector CALL almo_scf_ks_to_ks_blk(almo_scf_env) @@ -229,14 +223,20 @@ CONTAINS ! check convergence converged = .TRUE. IF (error_norm .GT. optimizer%eps_error) converged = .FALSE. + ! check other exit criteria: max SCF steps and timing CALL external_control(should_stop, "SCF", & start_time=qs_env%start_time, & target_time=qs_env%target_time) IF (should_stop .OR. iscf >= optimizer%max_iter .OR. converged) THEN prepare_to_exit = .TRUE. + IF (iscf == 1) energy_new = energy_old ENDIF + ! if early stopping is on do at least one iteration + IF (optimizer%early_stopping_on .AND. iscf .EQ. 1) & + prepare_to_exit = .FALSE. + IF (.NOT. prepare_to_exit) THEN ! update the ALMOs and density matrix ! perform mixing of KS matrices @@ -296,16 +296,56 @@ CONTAINS ! obtain ALMOs from matrix_p_blk: T_new = P_blk S_blk T_old CALL almo_scf_p_blk_to_t_blk(almo_scf_env, ionic=.FALSE.) - CALL almo_scf_t_blk_to_t_blk_orthonormal(almo_scf_env) + + DO ispin = 1, almo_scf_env%nspins + + CALL orthogonalize_mos(ket=almo_scf_env%matrix_t_blk(ispin), & + overlap=almo_scf_env%matrix_sigma_blk(ispin), & + metric=almo_scf_env%matrix_s_blk(1), & + retain_locality=.TRUE., & + only_normalize=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + eps_filter=almo_scf_env%eps_filter, & + order_lanczos=almo_scf_env%order_lanczos, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos) + + ENDDO END SELECT ! obtain density matrix from ALMOs - CALL almo_scf_t_blk_to_p(almo_scf_env, & - use_sigma_inv_guess=use_prev_as_guess) + DO ispin = 1, almo_scf_env%nspins + + CALL almo_scf_t_to_proj(t=almo_scf_env%matrix_t_blk(ispin), & + p=almo_scf_env%matrix_p(ispin), & + eps_filter=almo_scf_env%eps_filter, & + orthog_orbs=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + s=almo_scf_env%matrix_s(1), & + sigma=almo_scf_env%matrix_sigma(ispin), & + sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), & + use_guess=use_prev_as_guess, & + algorithm=almo_scf_env%sigma_inv_algorithm, & + inverse_accelerator=almo_scf_env%order_lanczos, & + inv_eps_factor=almo_scf_env%matrix_iter_eps_error_factor, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos, & + para_env=almo_scf_env%para_env, & + blacs_env=almo_scf_env%blacs_env) + + ENDDO + IF (almo_scf_env%nspins == 1) THEN + CALL dbcsr_scale(almo_scf_env%matrix_p(1), 2.0_dp) + ENDIF ! compute the new KS matrix and new energy - CALL almo_scf_dm_to_ks(qs_env, almo_scf_env, energy_new) + CALL almo_dm_to_almo_ks(qs_env, & + almo_scf_env%matrix_p, & + almo_scf_env%matrix_ks, & + energy_new, & + almo_scf_env%eps_filter, & + almo_scf_env%mat_distr_aos) ENDIF ! prepare_to_exit @@ -326,7 +366,7 @@ CONTAINS ENDDO ! end scf cycle - IF (.NOT. converged) THEN + IF (.NOT. converged .AND. (.NOT. optimizer%early_stopping_on)) THEN IF (unit_nr > 0) THEN CPABORT("SCF for block-diagonal ALMOs not converged!") ENDIF @@ -372,7 +412,6 @@ CONTAINS TYPE(almo_scf_diis_type), ALLOCATABLE, & DIMENSION(:) :: almo_diis TYPE(cp_logger_type), POINTER :: logger - TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks TYPE(dbcsr_type) :: matrix_p_almo_scf_converged TYPE(domain_submatrix_type), ALLOCATABLE, & DIMENSION(:, :) :: submatrix_mixing_old_blk @@ -472,19 +511,6 @@ CONTAINS iscf = iscf+1 - ! get a copy of the current KS matrix - CALL get_qs_env(qs_env, matrix_ks=matrix_ks) - DO ispin = 1, nspin - CALL matrix_qs_to_almo(matrix_ks(ispin)%matrix, & - almo_scf_env%matrix_ks(ispin), & - almo_scf_env, .FALSE.) - CALL matrix_qs_to_almo(matrix_ks(ispin)%matrix, & - almo_scf_env%matrix_ks_blk(ispin), & - almo_scf_env, .TRUE.) - CALL dbcsr_filter(almo_scf_env%matrix_ks(ispin), & - almo_scf_env%eps_filter) - ENDDO - ! obtain projected KS matrix and the DIIS-error vector CALL almo_scf_ks_to_ks_xx(almo_scf_env) @@ -517,6 +543,10 @@ CONTAINS prepare_to_exit = .TRUE. ENDIF + ! if early stopping is on do at least one iteration + IF (optimizer%early_stopping_on .AND. iscf .EQ. 1) & + prepare_to_exit = .FALSE. + IF (.NOT. prepare_to_exit) THEN ! update the ALMOs and density matrix ! perform mixing of KS matrices @@ -529,10 +559,6 @@ CONTAINS 1.0_dp-almo_scf_env%mixing_fraction, & submatrix_mixing_old_blk(:, ispin), & 'N') - !CALL dbcsr_add(almo_scf_env%matrix_ks_blk(ispin),& - ! matrix_mixing_old_blk(ispin),& - ! almo_scf_env%mixing_fraction,& - ! 1.0_dp-almo_scf_env%mixing_fraction) END DO ELSE DO ispin = 1, nspin @@ -564,15 +590,23 @@ CONTAINS ENDIF ! update now - CALL almo_scf_t_to_p( & + CALL almo_scf_t_to_proj( & t=almo_scf_env%matrix_t(ispin), & p=almo_scf_env%matrix_p(ispin), & eps_filter=almo_scf_env%eps_filter, & orthog_orbs=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & s=almo_scf_env%matrix_s(1), & sigma=almo_scf_env%matrix_sigma(ispin), & sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), & - use_guess=.TRUE.) + use_guess=.TRUE., & + algorithm=almo_scf_env%sigma_inv_algorithm, & + inverse_accelerator=almo_scf_env%order_lanczos, & + inv_eps_factor=almo_scf_env%matrix_iter_eps_error_factor, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos, & + para_env=almo_scf_env%para_env, & + blacs_env=almo_scf_env%blacs_env) CALL dbcsr_scale(almo_scf_env%matrix_p(ispin), spin_factor) ! obtain perturbative estimate (at no additional cost) @@ -670,7 +704,12 @@ CONTAINS ! compute the new KS matrix and new energy IF (.NOT. almo_scf_env%perturbative_delocalization) THEN - CALL almo_scf_dm_to_ks(qs_env, almo_scf_env, energy_new) + CALL almo_dm_to_almo_ks(qs_env, & + almo_scf_env%matrix_p, & + almo_scf_env%matrix_ks, & + energy_new, & + almo_scf_env%eps_filter, & + almo_scf_env%mat_distr_aos) ENDIF ENDIF ! prepare_to_exit @@ -678,6 +717,7 @@ CONTAINS IF (almo_scf_env%perturbative_delocalization) THEN ! exit after the first step if we do not need the SCF procedure + CALL almo_dm_to_qs_env(qs_env, almo_scf_env%matrix_p, almo_scf_env%mat_distr_aos) converged = .TRUE. prepare_to_exit = .TRUE. @@ -702,7 +742,7 @@ CONTAINS ENDDO ! end scf cycle - IF (.NOT. converged) THEN + IF (.NOT. converged .AND. .NOT. optimizer%early_stopping_on) THEN CPABORT("SCF for ALMOs on overlapping domains not converged! ") ENDIF @@ -753,27 +793,26 @@ CONTAINS routineP = moduleN//':'//routineN CHARACTER(LEN=20) :: iter_type - INTEGER :: cg_iteration, dim0, eda_unit, fixed_line_search_niter, handle, ispin, iteration, & - jj, line_search_iteration, max_iter, my_special_case, ncores, ndomains, nspins, occ1, & - outer_iteration, outer_max_iter, prec_type, precond_domain_projector, unit_nr, & - zero_neg_eiv - LOGICAL :: converged, do_md, first_md_iteration, just_started, line_search, & - md_in_theta_space, optimize_theta, outer_prepare_to_exit, prepare_to_exit, & - reset_conjugator, skip_grad, use_guess, use_preconditioner - REAL(kind=dp) :: appr_sec_der, beta, denom, e0, e1, energy_diff, energy_new, energy_old, & - eps_skip_gradients, g0, g1, grad_norm, grad_norm_frob, kappa, kin_energy, & - line_search_error, next_step_size_guess, numer, prec_sf_mixing_s, spin_factor, step_size, & - t1, t2, t_norm, tau, time_step - REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: evals + INTEGER :: cg_iteration, eda_unit, fixed_line_search_niter, handle, ispin, iteration, & + line_search_iteration, max_iter, my_special_case, ndomains, nspins, outer_iteration, & + outer_max_iter, prec_type, unit_nr + INTEGER, ALLOCATABLE, DIMENSION(:) :: nocc + LOGICAL :: blissful_neglect, converged, just_started, line_search, normalize_orbitals, & + optimize_theta, outer_prepare_to_exit, penalty_occ_vol, prepare_to_exit, & + reset_conjugator, skip_grad, use_guess + REAL(kind=dp) :: appr_sec_der, beta, denom, denom2, det1, e0, e1, energy_diff, energy_ispin, & + energy_new, energy_old, eps_skip_gradients, g0, g1, grad_norm, grad_norm_frob, & + line_search_error, next_step_size_guess, penalty_amplitude, penalty_func_new, & + spin_factor, step_size, t1, t2, tempreal + REAL(kind=dp), ALLOCATABLE, DIMENSION(:) :: grad_norm_spin, & + penalty_occ_vol_g_prefactor, & + penalty_occ_vol_h_prefactor TYPE(cp_logger_type), POINTER :: logger - TYPE(dbcsr_distribution_type) :: dist - TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks - TYPE(dbcsr_type) :: FTsiginv, fvo_0, grad, inv_eiv, m_tmp_nn_1, m_tmp_no_1, m_tmp_no_2, & - m_tmp_no_3, m_tmp_oo_1, prec_oo, prec_oo_inv, prec_vv, prev_grad, prev_minus_prec_grad, & - prev_step, siginvTFTsiginv, ST, step, STsiginv_0, velocity - TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: m_t_in_local, m_theta + TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: FTsiginv, grad, m_sig_sqrti_ii, m_t_in_local, & + m_theta, prec_vv, prev_grad, prev_minus_prec_grad, prev_step, siginvTFTsiginv, ST, step, & + STsiginv_0 TYPE(domain_submatrix_type), ALLOCATABLE, & - DIMENSION(:) :: domain_r_down + DIMENSION(:, :) :: bad_modes_projector_down, domain_r_down TYPE(section_vals_type), POINTER :: almo_print_section, input CALL timeset(routineN, handle) @@ -789,6 +828,8 @@ CONTAINS unit_nr = -1 ENDIF + nspins = almo_scf_env%nspins + IF (unit_nr > 0) THEN WRITE (unit_nr, *) SELECT CASE (my_special_case) @@ -810,39 +851,46 @@ CONTAINS ! set local parameters using developer's keywords ! RZK-warning: change to normal keywords later - do_md = almo_scf_env%logical01 optimize_theta = almo_scf_env%logical05 - prec_sf_mixing_s = almo_scf_env%real04 eps_skip_gradients = almo_scf_env%real01 + ! if unprojected XALMOs are optimized then compute both + ! then we must use the "blissful_neglect" procedure + blissful_neglect = .FALSE. + IF (my_special_case .EQ. xalmo_case_normal .AND. .NOT. assume_t0_q0x) THEN + blissful_neglect = .TRUE. + ENDIF + + ! penalty amplitude adjusts the strenght of volume conservation + ! the following guidelines are useful + ! A = T for n = 2 + ! A = 2T for n = 4 + ! A = (32/6)T for n = 6 + penalty_occ_vol = (almo_scf_env%penalty%occ_vol_method .NE. almo_occ_vol_penalty_none .AND. & + my_special_case .EQ. xalmo_case_fully_deloc) + normalize_orbitals = penalty_occ_vol + ! not used with lndet: penalty_order=2 + penalty_amplitude = almo_scf_env%penalty%occ_vol_coeff + ALLOCATE (penalty_occ_vol_g_prefactor(nspins)) + ALLOCATE (penalty_occ_vol_h_prefactor(nspins)) + penalty_occ_vol_g_prefactor(:) = 0.0_dp + penalty_occ_vol_h_prefactor(:) = 0.0_dp + penalty_func_new = 0.0_dp + ! preconditioner control - use_preconditioner = optimizer%preconditioner .NE. prec_zero - prec_type = 4 - ! RZK-warning: prec_type here is not the same as preconditioner - ! type in optimizer%preconditioner. change this later - !prec_type = optimizer%preconditioner - !if (prec_type.eq.prec_default) prec_type=prec_ks_plus_s + prec_type = optimizer%preconditioner ! control of the line search fixed_line_search_niter = 0 ! init to zero, change when eps is small enough - CALL dbcsr_get_info(almo_scf_env%matrix_s(1), distribution=dist) - CALL dbcsr_distribution_get(dist, numnodes=ncores) - - IF (almo_scf_env%nspins == 1) THEN + IF (nspins == 1) THEN spin_factor = 2.0_dp ELSE spin_factor = 1.0_dp ENDIF - !!!!!! RZK-warning THIS PROCEDURE WILL WORK ONLY FOR CLOSED SHELL SYSTEMS - !!!!!! TO ADAPT IT FOR UNRESTRICTED ORBITALS - UPDATE KS MATRIX WITH PARTIALLY - !!!!!! OPTIMIZED ORBITALS - BOTH ALPNA AND BETA - IF (almo_scf_env%nspins .GT. 1) THEN - CPABORT("UNRESTRICTED ALMO SCF IS NYI(!)") - ENDIF - - nspins = almo_scf_env%nspins + ALLOCATE (grad_norm_spin(nspins)) + ALLOCATE (nocc(nspins)) ! create a local copy of matrix_t_in because ! matrix_t_in and matrix_t_out can be the same matrix @@ -856,7 +904,8 @@ CONTAINS CALL dbcsr_copy(m_t_in_local(ispin), matrix_t_in(ispin)) ENDDO - ! init matrices for the initial guess + ! m_theta contains a set of variational parameters + ! that define one-electron orbitals (simple, projected, etc.) ALLOCATE (m_theta(nspins)) DO ispin = 1, nspins CALL dbcsr_create(m_theta(ispin), & @@ -879,79 +928,72 @@ CONTAINS eps_filter=almo_scf_env%eps_filter, & order_lanczos=almo_scf_env%order_lanczos, & eps_lanczos=almo_scf_env%eps_lanczos, & - max_iter_lanczos=almo_scf_env%max_iter_lanczos) + max_iter_lanczos=almo_scf_env%max_iter_lanczos, & + nocc_of_domain=almo_scf_env%nocc_of_domain) + ndomains = almo_scf_env%ndomains + ALLOCATE (domain_r_down(ndomains, nspins)) + CALL init_submatrices(domain_r_down) + ALLOCATE (bad_modes_projector_down(ndomains, nspins)) + CALL init_submatrices(bad_modes_projector_down) + + ALLOCATE (prec_vv(nspins)) + ALLOCATE (siginvTFTsiginv(nspins)) + ALLOCATE (STsiginv_0(nspins)) + ALLOCATE (FTsiginv(nspins)) + ALLOCATE (ST(nspins)) + ALLOCATE (prev_grad(nspins)) + ALLOCATE (grad(nspins)) + ALLOCATE (prev_step(nspins)) + ALLOCATE (step(nspins)) + ALLOCATE (prev_minus_prec_grad(nspins)) + ALLOCATE (m_sig_sqrti_ii(nspins)) DO ispin = 1, nspins ! init temporary storage - CALL dbcsr_create(prec_vv, & + CALL dbcsr_create(prec_vv(ispin), & template=almo_scf_env%matrix_ks(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(prec_oo, & + CALL dbcsr_create(siginvTFTsiginv(ispin), & template=almo_scf_env%matrix_sigma(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(prec_oo_inv, & - template=almo_scf_env%matrix_sigma(ispin), & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(m_tmp_oo_1, & - template=almo_scf_env%matrix_sigma(ispin), & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(siginvTFTsiginv, & - template=almo_scf_env%matrix_sigma(ispin), & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(STsiginv_0, & + CALL dbcsr_create(STsiginv_0(ispin), & template=matrix_t_out(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(m_tmp_no_1, & + CALL dbcsr_create(FTsiginv(ispin), & template=matrix_t_out(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(m_tmp_no_2, & + CALL dbcsr_create(ST(ispin), & template=matrix_t_out(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(m_tmp_no_3, & + CALL dbcsr_create(prev_grad(ispin), & template=matrix_t_out(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(FTsiginv, & + CALL dbcsr_create(grad(ispin), & template=matrix_t_out(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(ST, & + CALL dbcsr_create(prev_step(ispin), & template=matrix_t_out(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(prev_grad, & + CALL dbcsr_create(step(ispin), & template=matrix_t_out(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(grad, & + CALL dbcsr_create(prev_minus_prec_grad(ispin), & template=matrix_t_out(ispin), & matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(prev_step, & - template=matrix_t_out(ispin), & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(step, & - template=matrix_t_out(ispin), & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_create(prev_minus_prec_grad, & - template=matrix_t_out(ispin), & + CALL dbcsr_create(m_sig_sqrti_ii(ispin), & + template=almo_scf_env%matrix_sigma_inv(ispin), & matrix_type=dbcsr_type_no_symmetry) - ndomains = almo_scf_env%ndomains - ALLOCATE (domain_r_down(ndomains)) - CALL init_submatrices(domain_r_down) + CALL dbcsr_set(step(ispin), 0.0_dp) + CALL dbcsr_set(prev_step(ispin), 0.0_dp) - CALL dbcsr_set(step, 0.0_dp) - - md_in_theta_space = .FALSE. ! turn on later after several minimization steps - IF (do_md) THEN - CALL dbcsr_create(velocity, & - template=matrix_t_out(ispin)) - CALL dbcsr_copy(velocity, quench_t(ispin)) - CALL dbcsr_set(velocity, 0.0_dp) - CALL dbcsr_copy(prev_step, quench_t(ispin)) - CALL dbcsr_set(prev_step, 0.0_dp) - time_step = optimizer%lin_search_step_size_guess - ENDIF + CALL dbcsr_get_info(almo_scf_env%matrix_sigma_inv(ispin), & + nfullrows_total=nocc(ispin)) ! invert S domains if necessary - ! RZK-warning must be done outside the spin loop to save time + ! Note: domains for alpha and beta electrons might be different + ! that is why the inversion of the AO overlap is inside the spin loop IF (my_special_case .EQ. xalmo_case_normal) THEN CALL construct_domain_s_inv( & matrix_s=almo_scf_env%matrix_s(1), & @@ -959,31 +1001,40 @@ CONTAINS dpattern=quench_t(ispin), & map=almo_scf_env%domain_map(ispin), & node_of_domain=almo_scf_env%cpu_of_domain) + + CALL construct_domain_s_sqrt( & + matrix_s=almo_scf_env%matrix_s(1), & + subm_s_sqrt=almo_scf_env%domain_s_sqrt(:, ispin), & + subm_s_sqrt_inv=almo_scf_env%domain_s_sqrt_inv(:, ispin), & + dpattern=almo_scf_env%quench_t(ispin), & + map=almo_scf_env%domain_map(ispin), & + node_of_domain=almo_scf_env%cpu_of_domain) + ENDIF IF (assume_t0_q0x) THEN ! save S.T_0.siginv_0 - IF (special_case .EQ. xalmo_case_fully_deloc) THEN + IF (my_special_case .EQ. xalmo_case_fully_deloc) THEN CALL dbcsr_multiply("N", "N", 1.0_dp, & almo_scf_env%matrix_s(1), & almo_scf_env%matrix_t_blk(ispin), & - 0.0_dp, ST, & + 0.0_dp, ST(ispin), & filter_eps=almo_scf_env%eps_filter) CALL dbcsr_multiply("N", "N", 1.0_dp, & - ST, & + ST(ispin), & almo_scf_env%matrix_sigma_inv_0deloc(ispin), & - 0.0_dp, STsiginv_0, & + 0.0_dp, STsiginv_0(ispin), & filter_eps=almo_scf_env%eps_filter) ENDIF ! construct domain-projector - IF (my_special_case .EQ. xalmo_case_normal .AND. prec_type .EQ. 4) THEN + IF (my_special_case .EQ. xalmo_case_normal) THEN CALL construct_domain_r_down( & matrix_t=almo_scf_env%matrix_t_blk(ispin), & matrix_sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), & matrix_s=almo_scf_env%matrix_s(1), & - subm_r_down=domain_r_down(:), & + subm_r_down=domain_r_down(:, ispin), & dpattern=quench_t(ispin), & map=almo_scf_env%domain_map(ispin), & node_of_domain=almo_scf_env%cpu_of_domain, & @@ -992,174 +1043,110 @@ CONTAINS ENDIF ! assume_t0_q0x - IF (assume_t0_q0x) THEN + ENDDO ! ispin - ! save S.T_0.siginv_0 - IF (special_case .EQ. xalmo_case_fully_deloc) THEN - CALL dbcsr_multiply("N", "N", 1.0_dp, & - almo_scf_env%matrix_s(1), & - almo_scf_env%matrix_t_blk(ispin), & - 0.0_dp, ST, & - filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - ST, & - almo_scf_env%matrix_sigma_inv_0deloc(ispin), & - 0.0_dp, STsiginv_0, & - filter_eps=almo_scf_env%eps_filter) - ENDIF + ! start the outer SCF loop + outer_max_iter = optimizer%max_iter_outer_loop + outer_prepare_to_exit = .FALSE. + outer_iteration = 0 + grad_norm = 0.0_dp + grad_norm_frob = 0.0_dp + use_guess = .FALSE. - ! construct domain-projector - IF (my_special_case .EQ. xalmo_case_normal .AND. prec_type .EQ. 4) THEN - CALL construct_domain_r_down( & - matrix_t=almo_scf_env%matrix_t_blk(ispin), & - matrix_sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), & - matrix_s=almo_scf_env%matrix_s(1), & - subm_r_down=domain_r_down(:), & - dpattern=quench_t(ispin), & - map=almo_scf_env%domain_map(ispin), & - node_of_domain=almo_scf_env%cpu_of_domain, & - filter_eps=almo_scf_env%eps_filter) - ENDIF + DO - ENDIF ! assume_t0_q0x + ! start the inner SCF loop + max_iter = optimizer%max_iter + prepare_to_exit = .FALSE. + line_search = .FALSE. + converged = .FALSE. + iteration = 0 + cg_iteration = 0 + line_search_iteration = 0 + energy_new = 0.0_dp + energy_old = 0.0_dp + line_search_error = 0.0_dp - ! start the outer SCF loop - outer_max_iter = optimizer%max_iter_outer_loop - outer_prepare_to_exit = .FALSE. - outer_iteration = 0 - grad_norm = 0.0_dp - grad_norm_frob = 0.0_dp - use_guess = .FALSE. + t1 = m_walltime() DO - ! start the inner SCF loop - max_iter = optimizer%max_iter - prepare_to_exit = .FALSE. - line_search = .FALSE. - converged = .FALSE. - iteration = 0 - cg_iteration = 0 - line_search_iteration = 0 - energy_new = 0.0_dp - energy_old = 0.0_dp - line_search_error = 0.0_dp - t1 = m_walltime() + just_started = (iteration .EQ. 0) .AND. (outer_iteration .EQ. 0) - DO + DO ispin = 1, nspins - just_started = (iteration .EQ. 0) .AND. (outer_iteration .EQ. 0) + ! compute MO coefficients from the main variable + CALL compute_xalmos_from_main_var( & + m_var_in=m_theta(ispin), & + m_t_out=matrix_t_out(ispin), & + m_quench_t=quench_t(ispin), & + m_t0=almo_scf_env%matrix_t_blk(ispin), & + m_siginv=almo_scf_env%matrix_sigma_inv(ispin), & + m_STsiginv0=STsiginv_0(ispin), & + m_s=almo_scf_env%matrix_s(1), & + m_sig_sqrti_ii_out=m_sig_sqrti_ii(ispin), & + domain_r_down=domain_r_down(:, ispin), & + domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), & + domain_map=almo_scf_env%domain_map(ispin), & + cpu_of_domain=almo_scf_env%cpu_of_domain, & + assume_t0_q0x=assume_t0_q0x, & + just_started=just_started, & + optimize_theta=optimize_theta, & + normalize_orbitals=normalize_orbitals, & + envelope_amplitude=almo_scf_env%envelope_amplitude, & + eps_filter=almo_scf_env%eps_filter, & + special_case=my_special_case, & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + order_lanczos=almo_scf_env%order_lanczos, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos) - ! switch to MD after several minimization steps - IF (iteration .EQ. almo_scf_env%integer01 .AND. do_md) THEN - CALL dbcsr_set(velocity, 0.0_dp) - CALL dbcsr_set(prev_step, 0.0_dp) - md_in_theta_space = .TRUE. - first_md_iteration = .TRUE. - ENDIF - - ! check that all MO coefficients of the guess are less - ! than the maximum allowed amplitude - IF (optimize_theta) THEN - CALL dbcsr_copy(m_tmp_no_1, m_theta(ispin)) - CALL dbcsr_norm(m_tmp_no_1, & - dbcsr_norm_maxabsnorm, norm_scalar=t_norm) - IF (unit_nr > 0) THEN - WRITE (unit_nr, *) "Maximum norm of the initial guess: ", t_norm - WRITE (unit_nr, *) "Maximum allowed amplitude: ", & - almo_scf_env%envelope_amplitude - ENDIF - IF (t_norm .GT. almo_scf_env%envelope_amplitude .AND. just_started) THEN - CPABORT("Max norm of the initial guess is too large") - ENDIF - ! use artanh to tame the initial guess - CALL dbcsr_function_of_elements(m_tmp_no_1, & - func=dbcsr_func_tanh, & - a0=0.0_dp, & - a1=1.0_dp/almo_scf_env%envelope_amplitude) - !CALL dbcsr_function_of_elements(m_guess(ispin), & - ! func=dbcsr_func_artanh, & - ! a0=0.0_dp, & - ! a1=1.0_dp/envelope_amplitude) - CALL dbcsr_scale(m_tmp_no_1, & - almo_scf_env%envelope_amplitude) - !CALL dbcsr_scale(m_guess(ispin), envelope_amplitude) - ELSE - CALL dbcsr_copy(m_tmp_no_1, m_theta(ispin)) - ENDIF !optimize_theta - CALL dbcsr_hadamard_product(m_tmp_no_1, quench_t(ispin), & - matrix_t_out(ispin)) - - ! project out R_0 - IF (assume_t0_q0x) THEN - IF (my_special_case .EQ. xalmo_case_fully_deloc) THEN - CALL dbcsr_multiply("T", "N", 1.0_dp, & - STsiginv_0, & - matrix_t_out(ispin), & - 0.0_dp, m_tmp_oo_1, & - filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_multiply("N", "N", -1.0_dp, & - almo_scf_env%matrix_t_blk(ispin), & - m_tmp_oo_1, & - 1.0_dp, matrix_t_out(ispin), & - filter_eps=almo_scf_env%eps_filter) - ELSE IF (my_special_case .EQ. xalmo_case_block_diag) THEN - CPABORT("cannot use projector with block-daigonal ALMOs") - ELSE - ! no special case - CALL apply_domain_operators( & - matrix_in=matrix_t_out(ispin), & - matrix_out=m_tmp_no_1, & - operator1=domain_r_down(:), & - operator2=almo_scf_env%domain_s_inv(:, ispin), & - dpattern=quench_t(ispin), & - map=almo_scf_env%domain_map(ispin), & - node_of_domain=almo_scf_env%cpu_of_domain, & - my_action=1, & - filter_eps=almo_scf_env%eps_filter, & - !matrix_trimmer=,& - use_trimmer=.FALSE.) - CALL dbcsr_copy(matrix_t_out(ispin), & - m_tmp_no_1) - ENDIF ! special case - CALL dbcsr_add(matrix_t_out(ispin), & - almo_scf_env%matrix_t_blk(ispin), 1.0_dp, 1.0_dp) - ENDIF -!IF (just_started) & -!CALL dbcsr_print(matrix_t_out(ispin)) -! CALL dbcsr_filter(matrix_t_out(ispin), & -! eps=almo_scf_env%eps_filter) - - ! compute the density matrix - CALL almo_scf_t_to_p( & + ! compute the global projectors (for the density matrix) + CALL almo_scf_t_to_proj( & t=matrix_t_out(ispin), & p=almo_scf_env%matrix_p(ispin), & eps_filter=almo_scf_env%eps_filter, & orthog_orbs=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & s=almo_scf_env%matrix_s(1), & sigma=almo_scf_env%matrix_sigma(ispin), & sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), & - use_guess=use_guess) + use_guess=use_guess, & + algorithm=almo_scf_env%sigma_inv_algorithm, & + inv_eps_factor=almo_scf_env%matrix_iter_eps_error_factor, & + inverse_accelerator=almo_scf_env%order_lanczos, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos, & + para_env=almo_scf_env%para_env, & + blacs_env=almo_scf_env%blacs_env) + + ! compute dm from the projector(s) CALL dbcsr_scale(almo_scf_env%matrix_p(ispin), & spin_factor) - ! update the KS matrix and energy if necessary - IF (perturbation_only) THEN - IF (just_started) THEN + ENDDO ! ispin + + ! update the KS matrix and energy if necessary + IF (perturbation_only) THEN + ! note: do not combine with the pert_only statement + IF (just_started) THEN + DO ispin = 1, nspins CALL dbcsr_copy(almo_scf_env%matrix_ks(ispin), & almo_scf_env%matrix_ks_0deloc(ispin)) - ENDIF - ELSE - !!! RZK-warning the KS matrix must be updated outside the spin loop - !!! Now the code works only for restricted orbitals - CALL almo_scf_dm_to_ks(qs_env, almo_scf_env, energy_new) - CALL get_qs_env(qs_env, matrix_ks=matrix_ks) - CALL matrix_qs_to_almo(matrix_ks(ispin)%matrix, & - almo_scf_env%matrix_ks(ispin), & - almo_scf_env, .FALSE.) - CALL dbcsr_filter(almo_scf_env%matrix_ks(ispin), & - almo_scf_env%eps_filter) + ENDDO ENDIF + ELSE + ! the KS matrix is updated outside the spin loop + CALL almo_dm_to_almo_ks(qs_env, & + almo_scf_env%matrix_p, & + almo_scf_env%matrix_ks, & + energy_new, & + almo_scf_env%eps_filter, & + almo_scf_env%mat_distr_aos) + ENDIF + + !!!! RZK-warning: put the following into a subr - objective function + DO ispin = 1, nspins CALL compute_frequently_used_matrices( & filter_eps=almo_scf_env%eps_filter, & @@ -1167,819 +1154,649 @@ CONTAINS m_siginv_in=almo_scf_env%matrix_sigma_inv(ispin), & m_S_in=almo_scf_env%matrix_s(1), & m_F_in=almo_scf_env%matrix_ks(ispin), & - m_FTsiginv_out=FTsiginv, & - m_siginvTFTsiginv_out=siginvTFTsiginv, & - m_ST_out=ST) + m_FTsiginv_out=FTsiginv(ispin), & + m_siginvTFTsiginv_out=siginvTFTsiginv(ispin), & + m_ST_out=ST(ispin)) IF (perturbation_only) THEN ! calculate objective function Tr(F_0 R) - CALL dbcsr_trace(matrix_t_out(ispin), FTsiginv, energy_new) - energy_new = energy_new*spin_factor + IF (ispin .EQ. 1) energy_new = 0.0_dp + CALL dbcsr_trace(matrix_t_out(ispin), FTsiginv(ispin), energy_ispin) + energy_new = energy_new+energy_ispin*spin_factor + ENDIF + + IF (penalty_occ_vol) THEN +!CALL dbcsr_print(matrix_t_out(ispin)) +!CALL dbcsr_print(almo_scf_env%matrix_sigma(ispin)) + CALL determinant(almo_scf_env%matrix_sigma(ispin), det1, & + almo_scf_env%eps_filter) + penalty_func_new = & + -penalty_amplitude*spin_factor*nocc(ispin)* & + LOG(det1) + penalty_occ_vol_g_prefactor(ispin) = & + -2.0_dp*penalty_amplitude*spin_factor*nocc(ispin) + penalty_occ_vol_h_prefactor(ispin) = 0.0_dp + !!!! different penalty functions (lead to non-quadratic searches) + ! penalty_func_new = & + ! penalty_amplitude * spin_factor * nocc * & + ! (LOG(det1))**penalty_order + ! penalty_occ_vol_g_prefactor(ispin) = & + ! 2.0_dp * & + ! penalty_amplitude * spin_factor * nocc * & + ! penalty_order * & + ! (LOG(det1))**(penalty_order-1) + ! penalty_occ_vol_h_prefactor(ispin) = & + ! 2.0_dp * (penalty_order-1) / LOG(det1) + ! + ! penalty_func_new = & + ! penalty_amplitude * spin_factor * nocc * & + ! (1.0_dp-1.0_dp/det1)**penalty_order + ! penalty_occ_vol_g_prefactor(ispin) = & + ! 2.0_dp * & + ! penalty_amplitude * spin_factor * nocc * & + ! penalty_order * & + ! (1.0_dp/det1) * & + ! (1.0_dp-1.0_dp/det1)**(penalty_order-1) + ! penalty_occ_vol_h_prefactor(ispin) = & + ! 2.0_dp * (penalty_order-det1) / (det1 - 1.0_dp) + ! + ! penalty_func_new = & + ! penalty_amplitude * spin_factor * nocc * & + ! (1.0_dp-det1)**penalty_order + ! penalty_occ_vol_g_prefactor(ispin) = & + ! - 2.0_dp * & + ! penalty_amplitude * spin_factor * nocc * & + ! penalty_order * & + ! det1 * & + ! (1.0_dp-det1)**(penalty_order-1) + ! penalty_occ_vol_h_prefactor = & + ! 2.0_dp * ( 1.0_dp - (penalty_order-1) * det1 / (1.0_dp-det1) ) + IF (unit_nr > 0) THEN + WRITE (unit_nr, *) "penalty c0: ", penalty_occ_vol_g_prefactor(ispin) + WRITE (unit_nr, *) "penalty c1: ", penalty_occ_vol_h_prefactor(ispin) + WRITE (unit_nr, *) "penalty c0*c1: ", penalty_occ_vol_g_prefactor(ispin)*penalty_occ_vol_h_prefactor(ispin) + WRITE (unit_nr, *) "energy, penalty: ", energy_new, penalty_func_new + ENDIF + ! this is not pure energy anymore + energy_new = energy_new+penalty_func_new + ENDIF + + ENDDO ! ispin + !!!! -- end objective function + + DO ispin = 1, nspins + + IF (just_started .AND. almo_mathematica) THEN + IF (ispin .GT. 1) CPWARN("Mathematica files will be overwritten") + CALL print_mathematica_matrix(almo_scf_env%matrix_s(1), "matrixS.dat") + CALL print_mathematica_matrix(almo_scf_env%matrix_ks(ispin), "matrixF.dat") + CALL print_mathematica_matrix(matrix_t_out(ispin), "matrixT.dat") + CALL print_mathematica_matrix(quench_t(ispin), "matrixQ.dat") ENDIF ! save the previous gradient to compute beta ! do it only if the previous grad was computed ! for .NOT.line_search IF (line_search_iteration .EQ. 0 .AND. iteration .NE. 0) & - CALL dbcsr_copy(prev_grad, grad) + CALL dbcsr_copy(prev_grad(ispin), grad(ispin)) - ! compute the energy gradient if necessary - skip_grad = (iteration .GT. 0 .AND. & - fixed_line_search_niter .NE. 0 .AND. & - line_search_iteration .NE. fixed_line_search_niter) + ENDDO ! ispin - IF (.NOT. skip_grad) THEN + ! compute the energy gradient if necessary + skip_grad = (iteration .GT. 0 .AND. & + fixed_line_search_niter .NE. 0 .AND. & + line_search_iteration .NE. fixed_line_search_niter) + + IF (.NOT. skip_grad) THEN + + DO ispin = 1, nspins CALL compute_gradient( & - !m_grad_out=m_tmp_no_2,& - m_grad_out=grad, & + m_grad_out=grad(ispin), & m_ks=almo_scf_env%matrix_ks(ispin), & m_s=almo_scf_env%matrix_s(1), & m_t=matrix_t_out(ispin), & m_t0=almo_scf_env%matrix_t_blk(ispin), & m_siginv=almo_scf_env%matrix_sigma_inv(ispin), & m_quench_t=quench_t(ispin), & - m_FTsiginv=FTsiginv, & - m_siginvTFTsiginv=siginvTFTsiginv, & - m_ST=ST, & - m_STsiginv0=STsiginv_0, & + m_FTsiginv=FTsiginv(ispin), & + m_siginvTFTsiginv=siginvTFTsiginv(ispin), & + m_ST=ST(ispin), & + m_STsiginv0=STsiginv_0(ispin), & m_theta=m_theta(ispin), & - !m_sig_sqrti_ii=m_sig_sqrti_ii(ispin),& + m_sig_sqrti_ii=m_sig_sqrti_ii(ispin), & domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), & - domain_r_down=domain_r_down(:), & + domain_r_down=domain_r_down(:, ispin), & cpu_of_domain=almo_scf_env%cpu_of_domain, & domain_map=almo_scf_env%domain_map(ispin), & assume_t0_q0x=assume_t0_q0x, & optimize_theta=optimize_theta, & - perturbation_only=perturbation_only, & - normalize_orbitals=.FALSE., & - penalty_occ_vol=.FALSE., & - penalty_occ_vol_prefactor=0.0_dp, & - !normalize_orbitals=normalize_orbitals,& - !penalty_occ_vol=penalty_occ_vol,& - !penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor,& + normalize_orbitals=normalize_orbitals, & + penalty_occ_vol=penalty_occ_vol, & + penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(ispin), & envelope_amplitude=almo_scf_env%envelope_amplitude, & eps_filter=almo_scf_env%eps_filter, & spin_factor=spin_factor, & special_case=my_special_case) - ! RZK-warning: - ! some obsolete routines require gradient in m_tmp_no_2 - ! these must be removed and the line below deleted - CALL dbcsr_copy(m_tmp_no_2, grad) + ENDDO ! ispin - ENDIF ! skip_grad + ENDIF ! skip_grad - ! check convergence and other exit criteria - grad_norm_frob = dbcsr_frobenius_norm(grad) - CALL dbcsr_norm(grad, dbcsr_norm_maxabsnorm, & - norm_scalar=grad_norm) - converged = (grad_norm .LT. optimizer%eps_error) - IF (converged .OR. (iteration .GE. max_iter)) THEN - prepare_to_exit = .TRUE. - ENDIF - IF (grad_norm .LT. almo_scf_env%eps_prev_guess) THEN - use_guess = .TRUE. - ENDIF + ! if unprojected XALMOs are optimized then compute both + ! HessianInv/preconditioner and the "bad-mode" projector - IF (md_in_theta_space) THEN - - IF (.NOT. first_md_iteration) THEN - CALL dbcsr_copy(prev_step, step) + IF (blissful_neglect) THEN + DO ispin = 1, nspins + !compute the prec only for the first step, + !but project the gradient every step + IF (iteration .EQ. 0) THEN + CALL compute_preconditioner( & + domain_prec_out=almo_scf_env%domain_preconditioner(:, ispin), & + bad_modes_projector_down_out=bad_modes_projector_down(:, ispin), & + m_prec_out=prec_vv(ispin), & + m_ks=almo_scf_env%matrix_ks(ispin), & + m_s=almo_scf_env%matrix_s(1), & + m_siginv=almo_scf_env%matrix_sigma_inv(ispin), & + m_quench_t=quench_t(ispin), & + m_FTsiginv=FTsiginv(ispin), & + m_siginvTFTsiginv=siginvTFTsiginv(ispin), & + m_ST=ST(ispin), & + para_env=almo_scf_env%para_env, & + blacs_env=almo_scf_env%blacs_env, & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), & + domain_s_inv_half=almo_scf_env%domain_s_sqrt_inv(:, ispin), & + domain_s_half=almo_scf_env%domain_s_sqrt(:, ispin), & + domain_r_down=domain_r_down(:, ispin), & + cpu_of_domain=almo_scf_env%cpu_of_domain, & + domain_map=almo_scf_env%domain_map(ispin), & + assume_t0_q0x=assume_t0_q0x, & + penalty_occ_vol=penalty_occ_vol, & + penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(ispin), & + eps_filter=almo_scf_env%eps_filter, & + neg_thr=optimizer%neglect_threshold, & + spin_factor=spin_factor, & + special_case=my_special_case) ENDIF - CALL dbcsr_copy(step, grad) - CALL dbcsr_scale(step, -1.0_dp) + ! remove bad modes from the gradient + CALL apply_domain_operators( & + matrix_in=grad(ispin), & + matrix_out=grad(ispin), & + operator1=almo_scf_env%domain_s_inv(:, ispin), & + operator2=bad_modes_projector_down(:, ispin), & + dpattern=quench_t(ispin), & + map=almo_scf_env%domain_map(ispin), & + node_of_domain=almo_scf_env%cpu_of_domain, & + my_action=1, & + filter_eps=almo_scf_env%eps_filter) - ! update velocities v(i) = v(i-1) + 0.5*dT*(a(i-1) + a(i)) - IF (.NOT. first_md_iteration) THEN - CALL dbcsr_add(velocity, & - step, 1.0_dp, 0.5_dp*time_step) - CALL dbcsr_add(velocity, & - prev_step, 1.0_dp, 0.5_dp*time_step) - ENDIF - kin_energy = dbcsr_frobenius_norm(velocity) - kin_energy = 0.5_dp*kin_energy*kin_energy + ENDDO ! ispin - ! update positions theta(i) = theta(i-1) + dT*v(i-1) + 0.5*dT*dT*a(i-1) - CALL dbcsr_add(m_theta(ispin), & - velocity, 1.0_dp, time_step) - CALL dbcsr_add(m_theta(ispin), & - step, 1.0_dp, 0.5_dp*time_step*time_step) + ENDIF ! blissful neglect - iter_type = "MD" + ! check convergence and other exit criteria + DO ispin = 1, nspins + CALL dbcsr_norm(grad(ispin), dbcsr_norm_maxabsnorm, & + norm_scalar=grad_norm_spin(ispin)) + !grad_norm_frob = dbcsr_frobenius_norm(grad(ispin)) / & + ! dbcsr_frobenius_norm(quench_t(ispin)) + !IF (unit_nr > 0 ) WRITE(*,*) "Gradient RMS norm: ", grad_norm_frob + ENDDO ! ispin + grad_norm = MAXVAL(grad_norm_spin) - t2 = m_walltime() - IF (unit_nr > 0) THEN - WRITE (unit_nr, '(T2,A,A2,I5,F16.7,F17.9,F17.9,F17.9,E12.3,F10.3)') & - "ALMO SCF ", iter_type, iteration, time_step*iteration, & - energy_new, kin_energy, energy_new+kin_energy, grad_norm, & - t2-t1 - ENDIF - t1 = m_walltime() + converged = (grad_norm .LE. optimizer%eps_error) + IF (converged .OR. (iteration .GE. max_iter)) THEN + prepare_to_exit = .TRUE. + ENDIF + ! if early stopping is on do at least one iteration + IF (optimizer%early_stopping_on .AND. just_started) & + prepare_to_exit = .FALSE. - IF (first_md_iteration) THEN - first_md_iteration = .FALSE. - ENDIF + IF (grad_norm .LT. almo_scf_env%eps_prev_guess) & + use_guess = .TRUE. - ELSE ! optimizization (not MD) + ! it is not time to exit just yet + IF (.NOT. prepare_to_exit) THEN - IF (.NOT. prepare_to_exit) THEN + ! check the gradient along the step direction + ! and decide whether to switch to the line-search mode + ! do not do this in the first iteration + IF (iteration .NE. 0) THEN - ! check the gradient along the step direction - IF (iteration .NE. 0) THEN + IF (fixed_line_search_niter .EQ. 0) THEN - IF (fixed_line_search_niter .EQ. 0) THEN - - CALL dbcsr_trace(grad, step, line_search_error) - ! normalize the result - !IF (unit_nr>0) THEN - ! WRITE(unit_nr,*) "Angle between step/grad: ", line_search_error - !ENDIF - CALL dbcsr_trace(grad, grad, denom) - !IF (unit_nr>0) THEN - ! WRITE(unit_nr,*) "Frobenius norm of grad: ", SQRT(denom) - !ENDIF - line_search_error = line_search_error/SQRT(denom) - CALL dbcsr_trace(step, step, denom) - !IF (unit_nr>0) THEN - ! WRITE(unit_nr,*) "Frobenius norm of step: ", SQRT(denom) - !ENDIF - line_search_error = line_search_error/SQRT(denom) - IF (ABS(line_search_error) .GT. optimizer%lin_search_eps_error) THEN - line_search = .TRUE. - line_search_iteration = line_search_iteration+1 - ELSE - line_search = .FALSE. - line_search_iteration = 0 - IF (grad_norm .LT. eps_skip_gradients) THEN - fixed_line_search_niter = ABS(almo_scf_env%integer04) - ENDIF - ENDIF - - ELSE ! decision for fixed_line_search_niter - - IF (.NOT. line_search) THEN - line_search = .TRUE. - line_search_iteration = line_search_iteration+1 - ELSE - IF (line_search_iteration .EQ. fixed_line_search_niter) THEN - line_search = .FALSE. - line_search_iteration = 0 - line_search_iteration = line_search_iteration+1 - ENDIF - ENDIF - - ENDIF ! fixed_line_search_niter fork - ENDIF - - IF (line_search) THEN - energy_diff = 0.0_dp - ELSE - energy_diff = energy_new-energy_old - energy_old = energy_new - ENDIF - - ! update the step direction + ! enforce at least one line search + ! without even checking the error IF (.NOT. line_search) THEN - !IF (unit_nr>0) THEN - ! WRITE(unit_nr,*) "....updating step direction...." - !ENDIF + line_search = .TRUE. + line_search_iteration = line_search_iteration+1 - cg_iteration = cg_iteration+1 + ELSE - IF ((just_started .AND. perturbation_only) .OR. & - (iteration .EQ. 0 .AND. (.NOT. perturbation_only))) THEN + ! check the line-search error and decide whether to + ! change the direction + line_search_error = 0.0_dp + denom = 0.0_dp + denom2 = 0.0_dp - ! compute the preconditioner - !IF (unit_nr>0) THEN - ! WRITE(unit_nr,*) "....computing preconditioner...." - !ENDIF + DO ispin = 1, nspins - ! calculate (1-R)F(1-R) and S-SRS - ! RZK-warning take advantage: some elements will be removed by the quencher - ! RZK-warning S operations can be performed outside the spin loop to save time - ! IT IS REQUIRED THAT PRECONDITIONER DOES NOT BREAK THE LOCALITY!!!! - ! RZK-warning: further optimization is ABSOLUTELY NECESSARY + CALL dbcsr_trace(grad(ispin), step(ispin), tempreal) + line_search_error = line_search_error+tempreal + CALL dbcsr_trace(grad(ispin), grad(ispin), tempreal) + denom = denom+tempreal + CALL dbcsr_trace(step(ispin), step(ispin), tempreal) + denom2 = denom2+tempreal - ! First S-SRS - !CALL dbcsr_multiply("N","N",1.0_dp,& - ! almo_scf_env%matrix_s(1),& - ! matrix_t_out(ispin),& - ! 0.0_dp,m_tmp_no_1,& - ! filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - ST, & - almo_scf_env%matrix_sigma_inv(ispin), & - 0.0_dp, m_tmp_no_3, & - filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_create(m_tmp_nn_1, & - template=almo_scf_env%matrix_s(1), & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_desymmetrize(almo_scf_env%matrix_s(1), & - m_tmp_nn_1) - IF (my_special_case .EQ. xalmo_case_fully_deloc) THEN - ! use S instead of S-SRS - ELSE - CALL dbcsr_multiply("N", "T", -1.0_dp, & - ST, & - m_tmp_no_3, & - 1.0_dp, m_tmp_nn_1, & - filter_eps=almo_scf_env%eps_filter) + ENDDO ! ispin + + ! cosine of the angle between the step and grad + ! (must be close to zero at convergence) + line_search_error = line_search_error/SQRT(denom)/SQRT(denom2) + + IF (ABS(line_search_error) .GT. optimizer%lin_search_eps_error) THEN + line_search = .TRUE. + line_search_iteration = line_search_iteration+1 + ELSE + line_search = .FALSE. + line_search_iteration = 0 + IF (grad_norm .LT. eps_skip_gradients) THEN + fixed_line_search_niter = ABS(almo_scf_env%integer04) ENDIF + ENDIF - ! Second (1-R)F(1-R) - !CALL dbcsr_multiply("N","N",1.0_dp,& - ! almo_scf_env%matrix_ks(ispin),& - ! matrix_t_out(ispin),& - ! 0.0_dp,m_tmp_no_1,& - ! filter_eps=almo_scf_env%eps_filter) - ! re-create matrix because desymmetrize is buggy - - ! it will create multiple copies of blocks - CALL dbcsr_create(prec_vv, & - template=almo_scf_env%matrix_ks(ispin), & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_desymmetrize(almo_scf_env%matrix_ks(ispin), & - prec_vv) - CALL dbcsr_multiply("N", "T", -1.0_dp, & - FTsiginv, & - ST, & - 1.0_dp, prec_vv, & + ENDIF + + ELSE ! decision for fixed_line_search_niter + + IF (.NOT. line_search) THEN + line_search = .TRUE. + line_search_iteration = line_search_iteration+1 + ELSE + IF (line_search_iteration .EQ. fixed_line_search_niter) THEN + line_search = .FALSE. + line_search_iteration = 0 + line_search_iteration = line_search_iteration+1 + ENDIF + ENDIF + + ENDIF ! fixed_line_search_niter fork + + ENDIF ! iteration.ne.0 + + IF (line_search) THEN + energy_diff = 0.0_dp + ELSE + energy_diff = energy_new-energy_old + energy_old = energy_new + ENDIF + + ! update the step direction + IF (.NOT. line_search) THEN + + !IF (unit_nr>0) THEN + ! WRITE(unit_nr,*) "....updating step direction...." + !ENDIF + + cg_iteration = cg_iteration+1 + + ! save the previous step + DO ispin = 1, nspins + CALL dbcsr_copy(prev_step(ispin), step(ispin)) + ENDDO ! ispin + + ! compute the new step (apply preconditioner if available) + SELECT CASE (prec_type) + CASE (xalmo_prec_full) + + ! solving approximate Newton eq in the full (linearized) space + CALL newton_grad_to_step( & + optimizer=almo_scf_env%opt_xalmo_newton_pcg_solver, & + m_grad=grad(:), & + m_delta=step(:), & + m_s=almo_scf_env%matrix_s(:), & + m_ks=almo_scf_env%matrix_ks(:), & + m_siginv=almo_scf_env%matrix_sigma_inv(:), & + m_quench_t=quench_t(:), & + m_FTsiginv=FTsiginv(:), & + m_siginvTFTsiginv=siginvTFTsiginv(:), & + m_ST=ST(:), & + m_t=matrix_t_out(:), & + m_sig_sqrti_ii=m_sig_sqrti_ii(:), & + domain_s_inv=almo_scf_env%domain_s_inv(:, :), & + domain_r_down=domain_r_down(:, :), & + domain_map=almo_scf_env%domain_map(:), & + cpu_of_domain=almo_scf_env%cpu_of_domain, & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, :), & + para_env=almo_scf_env%para_env, & + blacs_env=almo_scf_env%blacs_env, & + eps_filter=almo_scf_env%eps_filter, & + optimize_theta=optimize_theta, & + penalty_occ_vol=penalty_occ_vol, & + normalize_orbitals=normalize_orbitals, & + penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(:), & + penalty_occ_vol_pf2=penalty_occ_vol_h_prefactor(:), & + special_case=my_special_case & + ) + + CASE (xalmo_prec_domain) + + ! compute and invert preconditioner? + IF (.NOT. blissful_neglect .AND. & + ((just_started .AND. perturbation_only) .OR. & + (iteration .EQ. 0 .AND. (.NOT. perturbation_only))) & + ) THEN + + ! computing preconditioner + DO ispin = 1, nspins + CALL compute_preconditioner( & + domain_prec_out=almo_scf_env%domain_preconditioner(:, ispin), & + m_prec_out=prec_vv(ispin), & + m_ks=almo_scf_env%matrix_ks(ispin), & + m_s=almo_scf_env%matrix_s(1), & + m_siginv=almo_scf_env%matrix_sigma_inv(ispin), & + m_quench_t=quench_t(ispin), & + m_FTsiginv=FTsiginv(ispin), & + m_siginvTFTsiginv=siginvTFTsiginv(ispin), & + m_ST=ST(ispin), & + para_env=almo_scf_env%para_env, & + blacs_env=almo_scf_env%blacs_env, & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + domain_s_inv=almo_scf_env%domain_s_inv(:, ispin), & + domain_r_down=domain_r_down(:, ispin), & + cpu_of_domain=almo_scf_env%cpu_of_domain, & + domain_map=almo_scf_env%domain_map(ispin), & + assume_t0_q0x=assume_t0_q0x, & + penalty_occ_vol=penalty_occ_vol, & + penalty_occ_vol_prefactor=penalty_occ_vol_g_prefactor(ispin), & + eps_filter=almo_scf_env%eps_filter, & + neg_thr=0.5_dp, & + spin_factor=spin_factor, & + special_case=my_special_case) + ENDDO ! ispin + ENDIF ! compute_prec + + !IF (unit_nr>0) THEN + ! WRITE(unit_nr,*) "....applying precomputed preconditioner...." + !ENDIF + + IF (my_special_case .EQ. xalmo_case_block_diag .OR. & + my_special_case .EQ. xalmo_case_fully_deloc) THEN + + DO ispin = 1, nspins + + CALL dbcsr_multiply("N", "N", -1.0_dp, & + prec_vv(ispin), & + grad(ispin), & + 0.0_dp, step(ispin), & filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_multiply("N", "T", -1.0_dp, & - ST, & - FTsiginv, & - 1.0_dp, prec_vv, & - filter_eps=almo_scf_env%eps_filter) - !CALL dbcsr_multiply("T","N",1.0_dp,& - ! matrix_t_out(ispin),& - ! m_tmp_no_1,& - ! 0.0_dp,m_tmp_oo_1,& - ! filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - ST, & - siginvTFTsiginv, & - 0.0_dp, m_tmp_no_3, & - filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_multiply("N", "T", 1.0_dp, & - m_tmp_no_3, & - ST, & - 1.0_dp, prec_vv, & - filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_add(prec_vv, m_tmp_nn_1, & - 1.0_dp-prec_sf_mixing_s, & - prec_sf_mixing_s) - CALL dbcsr_scale(prec_vv, 2.0_dp*spin_factor) - CALL dbcsr_copy(m_tmp_nn_1, prec_vv) - ! invert using various algorithms - IF (my_special_case .EQ. xalmo_case_block_diag) THEN ! non-overlapping diagonal blocks + ENDDO ! ispin - !precond_domain_projector=0 - !CALL construct_domain_preconditioner(& - ! matrix_main=m_tmp_nn_1,& - ! dpattern=quench_t(ispin),& - ! map=almo_scf_env%domain_map(ispin),& - ! node_of_domain=almo_scf_env%cpu_of_domain,& - ! preconditioner=almo_scf_env%domain_preconditioner(:,ispin),& - ! use_trimmer=.FALSE.,& - ! my_action=precond_domain_projector) - CALL pseudo_invert_diagonal_blk(matrix_in=m_tmp_nn_1, & - matrix_out=prec_vv, & - nocc=almo_scf_env%nocc_of_domain(:, ispin)) + ELSE - ELSE IF (my_special_case .EQ. xalmo_case_fully_deloc) THEN ! the entire system is a block + !!! RZK-warning Currently for non-theta only + IF (optimize_theta) THEN + CPABORT("theta is NYI") + ENDIF - ! invert using cholesky (works with S matrix, will not work with S-SRS matrix) - CALL cp_dbcsr_cholesky_decompose(prec_vv, & - para_env=almo_scf_env%para_env, & - blacs_env=almo_scf_env%blacs_env) - CALL cp_dbcsr_cholesky_invert(prec_vv, & - para_env=almo_scf_env%para_env, & - blacs_env=almo_scf_env%blacs_env, & - upper_to_full=.TRUE.) - CALL dbcsr_filter(prec_vv, & - eps=almo_scf_env%eps_filter) - ELSE - !!! use a sophisticated domain preconditioner - IF (assume_t0_q0x) THEN - precond_domain_projector = -1 - ELSE - precond_domain_projector = 0 - ENDIF - ! for other experimental preconditioner types the inversion is - ! done together with applying the preconditioner - IF (prec_type .EQ. 4) THEN + DO ispin = 1, nspins - CALL construct_domain_preconditioner( & - matrix_main=m_tmp_nn_1, & - subm_s_inv=almo_scf_env%domain_s_inv(:, ispin), & - subm_r_down=domain_r_down(:), & - matrix_trimmer=quench_t(ispin), & - dpattern=quench_t(ispin), & - map=almo_scf_env%domain_map(ispin), & - node_of_domain=almo_scf_env%cpu_of_domain, & - preconditioner=almo_scf_env%domain_preconditioner(:, ispin), & - use_trimmer=.FALSE., & - my_action=precond_domain_projector) - ENDIF ! prec type - ENDIF + CALL apply_domain_operators( & + matrix_in=grad(ispin), & + matrix_out=step(ispin), & + operator1=almo_scf_env%domain_preconditioner(:, ispin), & + dpattern=quench_t(ispin), & + map=almo_scf_env%domain_map(ispin), & + node_of_domain=almo_scf_env%cpu_of_domain, & + my_action=0, & + filter_eps=almo_scf_env%eps_filter) + CALL dbcsr_scale(step(ispin), -1.0_dp) - ! invert using cholesky (works with S matrix, will not work with S-SRS matrix) - !!!CALL cp_dbcsr_cholesky_decompose(prec_vv,& - !!! para_env=almo_scf_env%para_env,& - !!! blacs_env=almo_scf_env%blacs_env) - !!!CALL cp_dbcsr_cholesky_invert(prec_vv,& - !!! para_env=almo_scf_env%para_env,& - !!! blacs_env=almo_scf_env%blacs_env,& - !!! upper_to_full=.TRUE.) - !!!CALL dbcsr_filter(prec_vv,& - !!! eps=almo_scf_env%eps_filter) - !!! - - ! re-create the matrix because desymmetrize is buggy - - ! it will create multiple copies of blocks - !!!DESYM!CALL dbcsr_create(prec_vv,& - !!!DESYM! template=almo_scf_env%matrix_s(1),& - !!!DESYM! matrix_type=dbcsr_type_no_symmetry) - !!!DESYM!CALL dbcsr_desymmetrize(almo_scf_env%matrix_s(1),& - !!!DESYM! prec_vv) - !CALL dbcsr_multiply("N","N",1.0_dp,& - ! almo_scf_env%matrix_s(1),& - ! matrix_t_out(ispin),& - ! 0.0_dp,m_tmp_no_1,& - ! filter_eps=almo_scf_env%eps_filter) - !CALL dbcsr_multiply("N","N",1.0_dp,& - ! m_tmp_no_1,& - ! almo_scf_env%matrix_sigma_inv(ispin),& - ! 0.0_dp,m_tmp_no_3,& - ! filter_eps=almo_scf_env%eps_filter) - !CALL dbcsr_multiply("N","T",-1.0_dp,& + !CALL dbcsr_copy(m_tmp_no_3,& + ! quench_t(ispin)) + !CALL dbcsr_function_of_elements(m_tmp_no_3,& + ! func=dbcsr_func_inverse,& + ! a0=0.0_dp,& + ! a1=1.0_dp) + !CALL dbcsr_copy(m_tmp_no_2,step) + !CALL dbcsr_hadamard_product(& + ! m_tmp_no_2,& ! m_tmp_no_3,& - ! m_tmp_no_1,& - ! 1.0_dp,prec_vv,& - ! filter_eps=almo_scf_env%eps_filter) - !CALL dbcsr_add_on_diag(prec_vv,& - ! prec_sf_mixing_s) + ! step) + !CALL dbcsr_copy(m_tmp_no_3,quench_t(ispin)) - !CALL dbcsr_create(prec_oo,& - ! template=almo_scf_env%matrix_sigma(ispin),& - ! matrix_type=dbcsr_type_no_symmetry) - !CALL dbcsr_desymmetrize(almo_scf_env%matrix_sigma(ispin),& - ! matrix_type=dbcsr_type_no_symmetry) - !CALL dbcsr_desymmetrize(almo_scf_env%matrix_sigma(ispin),& - ! prec_oo) - !CALL dbcsr_filter(prec_oo,& - ! eps=almo_scf_env%eps_filter) + ENDDO ! ispin - !! invert using cholesky - !CALL dbcsr_create(prec_oo_inv,& - ! template=prec_oo,& - ! matrix_type=dbcsr_type_no_symmetry) - !CALL dbcsr_desymmetrize(prec_oo,& - ! prec_oo_inv) - !CALL cp_dbcsr_cholesky_decompose(prec_oo_inv,& - ! para_env=almo_scf_env%para_env,& - ! blacs_env=almo_scf_env%blacs_env) - !CALL cp_dbcsr_cholesky_invert(prec_oo_inv,& - ! para_env=almo_scf_env%para_env,& - ! blacs_env=almo_scf_env%blacs_env,& - ! upper_to_full=.TRUE.) + ENDIF ! special case - ENDIF + CASE (xalmo_prec_zero) - ! save the previous step - CALL dbcsr_copy(prev_step, step) + ! no preconditioner + DO ispin = 1, nspins - ! compute the new step (apply preconditioner if available) - IF (use_preconditioner) THEN + CALL dbcsr_copy(step(ispin), grad(ispin)) + CALL dbcsr_scale(step(ispin), -1.0_dp) - !IF (unit_nr>0) THEN - ! WRITE(unit_nr,*) "....applying preconditioner...." - !ENDIF + ENDDO ! ispin - SELECT CASE (prec_type) - CASE (1) - ! expensive Newton-Raphson step (the Hessian is still approximate) - ! RZK-warning THIS PREC HAS NOT BEEN IMPLEMENTED FOR THETA - IF (ncores .GT. 1) THEN - CPABORT("serial code only") - ENDIF - CALL newton_grad_to_step( & - matrix_grad=m_tmp_no_2, & - matrix_step=m_tmp_no_1, & - matrix_s=almo_scf_env%matrix_s(1), & - matrix_ks=almo_scf_env%matrix_ks(ispin), & - matrix_t=matrix_t_out(ispin), & - matrix_sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), & - !matrix_ks=matrix_ks_0,& - !matrix_t=almo_scf_env%matrix_t_blk(ispin),& - !matrix_sigma_inv=matrix_sigma_inv_0,& - quench_t=quench_t(ispin), & - spin_factor=spin_factor, & - eps_filter=almo_scf_env%eps_filter) + END SELECT ! preconditioner type fork - CASE (3) + ! check whether we need to reset conjugate directions + IF (iteration .EQ. 0) THEN + reset_conjugator = .TRUE. + ENDIF - ! RZK-warning THIS PREC HAS NOT BEEN IMPLEMENTED FOR THETA + ! compute the conjugation coefficient - beta + IF (.NOT. reset_conjugator) THEN - ! inversion - CALL dbcsr_get_info(m_tmp_nn_1, nfullrows_total=dim0) - ALLOCATE (evals(dim0)) - CALL cp_dbcsr_syevd(m_tmp_nn_1, prec_vv, evals, & - almo_scf_env%para_env, almo_scf_env%blacs_env) - ! invert eigenvalues and use eigenvectors to compute the Hessian inverse - ! take special care of zero eigenvalues - zero_neg_eiv = 0 - CALL dbcsr_get_info(almo_scf_env%matrix_sigma(ispin), nfullrows_total=occ1) - DO jj = 1, dim0 - IF (jj .LE. occ1) THEN - evals(jj) = evals(jj)*0.0_dp - zero_neg_eiv = zero_neg_eiv+1 - ELSE - evals(jj) = 1.0_dp/evals(jj) - ENDIF - ENDDO - IF (unit_nr > 0) THEN - WRITE (unit_nr, *) 'ZERO OR NEGATIVE EIGENVALUES: ', zero_neg_eiv - ENDIF - CALL dbcsr_create(inv_eiv, & - template=m_tmp_nn_1, & - matrix_type=dbcsr_type_no_symmetry) - CALL dbcsr_add_on_diag(inv_eiv, 1.0_dp) - CALL dbcsr_set_diag(inv_eiv, evals) - CALL dbcsr_multiply("N", "N", 1.0_dp, & - prec_vv, & - inv_eiv, & - 0.0_dp, m_tmp_nn_1, & - filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_multiply("N", "T", 1.0_dp, & - m_tmp_nn_1, & - prec_vv, & - 0.0_dp, inv_eiv, & - filter_eps=almo_scf_env%eps_filter) - CALL dbcsr_copy(prec_vv, inv_eiv) - CALL dbcsr_release(inv_eiv) - DEALLOCATE (evals) + CALL compute_cg_beta( & + beta=beta, & + reset_conjugator=reset_conjugator, & + conjugator=optimizer%conjugator, & + grad=grad(:), & + prev_grad=prev_grad(:), & + step=step(:), & + prev_step=prev_step(:), & + prev_minus_prec_grad=prev_minus_prec_grad(:) & + ) - !!CALL dbcsr_copy(step,& - !! quench_t(ispin)) - !! - !!CALL dbcsr_multiply("N","N",1.0_dp,& - !! m_tmp_no_2,& - !! !grad,& - this choice is worse - !! prec_oo,& - !! 0.0_dp,step,& - !! !retain_sparsity=.TRUE.,& - !! filter_eps=almo_scf_env%eps_filter) - !! - CALL dbcsr_copy(m_tmp_no_1, & - quench_t(ispin)) - !!CALL dbcsr_hadamard_product(& - !! quench_t(ispin),& - !! step,& - !! m_tmp_no_1) - !! - CALL dbcsr_multiply("N", "N", -1.0_dp, & - prec_vv, & - m_tmp_no_2, & - 0.0_dp, m_tmp_no_1, & - retain_sparsity=.TRUE.) + ENDIF - CASE (4) + IF (reset_conjugator) THEN - IF (my_special_case .EQ. xalmo_case_block_diag .OR. & - my_special_case .EQ. xalmo_case_fully_deloc) THEN - - CALL dbcsr_multiply("N", "N", -1.0_dp, & - prec_vv, & - grad, & - 0.0_dp, step, & - filter_eps=almo_scf_env%eps_filter) - - ELSE - - !!! RZK-warning Currently for non-theta only - IF (optimize_theta) THEN - CPABORT("theta is NYI") - ENDIF - - CALL apply_domain_operators( & - matrix_in=grad, & - matrix_out=step, & - operator1=almo_scf_env%domain_preconditioner(:, ispin), & - !operator2=,& - dpattern=quench_t(ispin), & - map=almo_scf_env%domain_map(ispin), & - node_of_domain=almo_scf_env%cpu_of_domain, & - my_action=0, & - filter_eps=almo_scf_env%eps_filter) - !matrix_trimmer=,& - !use_trimmer=.FALSE.,& - CALL dbcsr_scale(step, -1.0_dp) - - CALL dbcsr_copy(m_tmp_no_3, & - quench_t(ispin)) - CALL dbcsr_function_of_elements(m_tmp_no_3, & - func=dbcsr_func_inverse, & - a0=0.0_dp, & - a1=1.0_dp) - CALL dbcsr_copy(m_tmp_no_2, step) - CALL dbcsr_hadamard_product( & - m_tmp_no_2, & - m_tmp_no_3, & - step) - CALL dbcsr_copy(m_tmp_no_3, quench_t(ispin)) - - !CALL dbcsr_create(m_tmp_oo_1,& - ! template=almo_scf_env%matrix_sigma_blk(ispin),& - ! matrix_type=dbcsr_type_no_symmetry) - !CALL dbcsr_desymmetrize(almo_scf_env%matrix_sigma_blk(ispin),m_tmp_oo_1) - !CALL get_overlap(bra=matrix_t_out(ispin),& - ! ket=step,& - ! overlap=m_tmp_oo_1,& - ! metric=almo_scf_env%matrix_s(1),& - ! retain_overlap_sparsity=.TRUE.,& - ! eps_filter=almo_scf_env%eps_filter) - !CALL dbcsr_norm(m_tmp_oo_1,& - ! dbcsr_norm_maxabsnorm, norm_scalar=t_norm) - !IF (unit_nr>0) THEN - ! WRITE(unit_nr,*) "Step block-orthogonality error: ", t_norm - !ENDIF - - ENDIF ! special case - - END SELECT ! preconditioner type fork - - ELSE - - !!!! NO PRECONDITIONER - CALL dbcsr_copy(step, grad) - CALL dbcsr_scale(step, -1.0_dp) - - ENDIF - - ! check whether we need to reset conjugate directions - IF (iteration .EQ. 0) THEN - reset_conjugator = .TRUE. - ENDIF - - ! compute the conjugation coefficient - beta - IF (.NOT. reset_conjugator) THEN - - SELECT CASE (optimizer%conjugator) - CASE (cg_hestenes_stiefel) - CALL dbcsr_copy(m_tmp_no_1, grad) - CALL dbcsr_add(m_tmp_no_1, prev_grad, & - 1.0_dp, -1.0_dp) - CALL dbcsr_trace(m_tmp_no_1, step, numer) - CALL dbcsr_trace(m_tmp_no_1, prev_step, denom) - beta = -1.0_dp*numer/denom - CASE (cg_fletcher_reeves) - CALL dbcsr_trace(grad, step, numer) - CALL dbcsr_trace(prev_grad, prev_minus_prec_grad, denom) - beta = numer/denom - CASE (cg_polak_ribiere) - CALL dbcsr_trace(prev_grad, prev_minus_prec_grad, denom) - CALL dbcsr_copy(m_tmp_no_1, grad) - CALL dbcsr_add(m_tmp_no_1, prev_grad, 1.0_dp, -1.0_dp) - CALL dbcsr_trace(m_tmp_no_1, step, numer) - beta = numer/denom - CASE (cg_fletcher) - CALL dbcsr_trace(grad, step, numer) - CALL dbcsr_trace(prev_grad, prev_step, denom) - beta = numer/denom - CASE (cg_liu_storey) - CALL dbcsr_trace(prev_grad, prev_step, denom) - CALL dbcsr_copy(m_tmp_no_1, grad) - CALL dbcsr_add(m_tmp_no_1, prev_grad, 1.0_dp, -1.0_dp) - CALL dbcsr_trace(m_tmp_no_1, step, numer) - beta = numer/denom - CASE (cg_dai_yuan) - CALL dbcsr_trace(grad, step, numer) - CALL dbcsr_copy(m_tmp_no_1, grad) - CALL dbcsr_add(m_tmp_no_1, prev_grad, 1.0_dp, -1.0_dp) - CALL dbcsr_trace(m_tmp_no_1, prev_step, denom) - beta = -1.0_dp*numer/denom - CASE (cg_hager_zhang) - CALL dbcsr_copy(m_tmp_no_1, grad) - CALL dbcsr_add(m_tmp_no_1, prev_grad, 1.0_dp, -1.0_dp) - CALL dbcsr_trace(m_tmp_no_1, prev_step, denom) - CALL dbcsr_trace(m_tmp_no_1, prev_minus_prec_grad, numer) - kappa = -2.0_dp*numer/denom - CALL dbcsr_trace(m_tmp_no_1, step, numer) - tau = -1.0_dp*numer/denom - CALL dbcsr_trace(prev_step, grad, numer) - beta = tau-kappa*numer/denom - CASE (cg_zero) - beta = 0.0_dp - CASE DEFAULT - CPABORT("illegal conjugator") - END SELECT - - IF (beta .LT. 0.0_dp) THEN - IF (unit_nr > 0) THEN - WRITE (unit_nr, *) "Beta is negative: ", beta - ENDIF - reset_conjugator = .TRUE. - ENDIF - - ENDIF - - IF (reset_conjugator) THEN - - beta = 0.0_dp - IF (unit_nr > 0 .AND. (.NOT. just_started)) THEN - WRITE (unit_nr, *) "(Re)-setting conjugator to zero" - ENDIF - reset_conjugator = .FALSE. - - ENDIF - - ! save the preconditioned gradient (useful for beta) - CALL dbcsr_copy(prev_minus_prec_grad, step) - - !IF (unit_nr>0) THEN - ! WRITE(unit_nr,*) "....final beta....", beta - !ENDIF - - ! conjugate the step direction - CALL dbcsr_add(step, prev_step, 1.0_dp, beta) - - ENDIF ! update the step direction - - ! estimate the step size - IF (.NOT. line_search) THEN - e0 = energy_new - CALL dbcsr_trace(grad, step, g0) - ! we just changed the direction and - ! we have only E and grad from the current step - ! it is not enouhg to compute step_size - just guess it - IF (iteration .EQ. 0) THEN - step_size = optimizer%lin_search_step_size_guess - ELSE - IF (next_step_size_guess .LE. 0.0_dp) THEN - step_size = optimizer%lin_search_step_size_guess - ELSE - ! take the last value - step_size = next_step_size_guess*1.05_dp - ENDIF - ENDIF - next_step_size_guess = step_size - ELSE - IF (fixed_line_search_niter .EQ. 0) THEN - e1 = energy_new - CALL dbcsr_trace(grad, step, g1) - ! we have accumulated some points along this direction - ! use only the most recent g0 (quadratic approximation) - appr_sec_der = (g1-g0)/step_size - !IF (unit_nr>0) THEN - ! WRITE(unit_nr,'(A2,7F12.5)') & - ! "EG",e0,e1,g0,g1,appr_sec_der,step_size,-g1/appr_sec_der - !ENDIF - step_size = -g1/appr_sec_der - e0 = e1 - g0 = g1 - ELSE - ! use e0, g0 and e1 to compute g1 and make a step - ! if the next iteration is also line_search - ! use e1 and the calculated g1 as e0 and g0 - e1 = energy_new - appr_sec_der = 2.0*((e1-e0)/step_size-g0)/step_size - g1 = appr_sec_der*step_size+g0 - IF (unit_nr > 0) THEN - WRITE (unit_nr, '(A2,7F12.5)') & - "EG", e0, e1, g0, g1, appr_sec_der, step_size, -g1/appr_sec_der - ENDIF - !appr_sec_der=(g1-g0)/step_size - step_size = -g1/appr_sec_der - e0 = e1 - g0 = g1 - ENDIF - next_step_size_guess = next_step_size_guess+step_size + beta = 0.0_dp + IF (unit_nr > 0 .AND. (.NOT. just_started)) THEN + WRITE (unit_nr, '(T2,A35)') "Re-setting conjugator to zero" ENDIF + reset_conjugator = .FALSE. - ! update theta - CALL dbcsr_add(m_theta(ispin), step, 1.0_dp, step_size) + ENDIF - ENDIF ! not.prepare_to_exit + ! save the preconditioned gradient (useful for beta) + DO ispin = 1, nspins - IF (line_search) THEN - iter_type = "LS" + CALL dbcsr_copy(prev_minus_prec_grad(ispin), step(ispin)) + + !IF (unit_nr>0) THEN + ! WRITE(unit_nr,*) "....final beta....", beta + !ENDIF + + ! conjugate the step direction + CALL dbcsr_add(step(ispin), prev_step(ispin), 1.0_dp, beta) + + ENDDO ! ispin + + ENDIF ! update the step direction + + ! estimate the step size + IF (.NOT. line_search) THEN + ! we just changed the direction and + ! we have only E and grad from the current step + ! it is not enouhg to compute step_size - just guess it + e0 = energy_new + g0 = 0.0_dp + DO ispin = 1, nspins + CALL dbcsr_trace(grad(ispin), step(ispin), tempreal) + g0 = g0+tempreal + ENDDO ! ispin + IF (iteration .EQ. 0) THEN + step_size = optimizer%lin_search_step_size_guess ELSE - iter_type = "CG" + IF (next_step_size_guess .LE. 0.0_dp) THEN + step_size = optimizer%lin_search_step_size_guess + ELSE + ! take the last value + step_size = next_step_size_guess*1.05_dp + ENDIF ENDIF - - t2 = m_walltime() - IF (unit_nr > 0) THEN - iter_type = TRIM("ALMO SCF "//iter_type) - WRITE (unit_nr, '(T2,A13,I6,F23.10,E14.5,F14.9,F9.2)') & - iter_type, iteration, & - energy_new, energy_diff, grad_norm, & - t2-t1 - !WRITE(unit_nr,'(T2,A11,I6,F20.12,E12.3,E12.3,E12.3,F12.5,F10.3)') & - ! "ALMO SCF ",iter_type,iteration,& - ! energy_new,energy_diff,grad_norm,line_search_error,& - ! step_size,t2-t1 + !IF (unit_nr > 0) THEN + ! WRITE (unit_nr, '(A2,3F12.5)') & + ! "EG", e0, g0, step_size + !ENDIF + next_step_size_guess = step_size + ELSE + IF (fixed_line_search_niter .EQ. 0) THEN + e1 = energy_new + g1 = 0.0_dp + DO ispin = 1, nspins + CALL dbcsr_trace(grad(ispin), step(ispin), tempreal) + g1 = g1+tempreal + ENDDO ! ispin + ! we have accumulated some points along this direction + ! use only the most recent g0 (quadratic approximation) + appr_sec_der = (g1-g0)/step_size + !IF (unit_nr > 0) THEN + ! WRITE (unit_nr, '(A2,7F12.5)') & + ! "EG", e0, e1, g0, g1, appr_sec_der, step_size, -g1/appr_sec_der + !ENDIF + step_size = -g1/appr_sec_der + e0 = e1 + g0 = g1 + ELSE + ! use e0, g0 and e1 to compute g1 and make a step + ! if the next iteration is also line_search + ! use e1 and the calculated g1 as e0 and g0 + e1 = energy_new + appr_sec_der = 2.0*((e1-e0)/step_size-g0)/step_size + g1 = appr_sec_der*step_size+g0 + !IF (unit_nr > 0) THEN + ! WRITE (unit_nr, '(A2,7F12.5)') & + ! "EG", e0, e1, g0, g1, appr_sec_der, step_size, -g1/appr_sec_der + !ENDIF + !appr_sec_der=(g1-g0)/step_size + step_size = -g1/appr_sec_der + e0 = e1 + g0 = g1 ENDIF + next_step_size_guess = next_step_size_guess+step_size + ENDIF - IF (my_special_case .EQ. xalmo_case_block_diag) THEN - almo_scf_env%almo_scf_energy = energy_new - ENDIF + ! update theta + DO ispin = 1, nspins + CALL dbcsr_add(m_theta(ispin), step(ispin), 1.0_dp, step_size) + ENDDO ! ispin - t1 = m_walltime() + ENDIF ! not.prepare_to_exit - ENDIF ! MD in theta space - - iteration = iteration+1 - IF (prepare_to_exit) EXIT - - ENDDO ! inner SCF loop - - IF (converged .OR. (outer_iteration .GE. outer_max_iter)) THEN - outer_prepare_to_exit = .TRUE. + IF (line_search) THEN + iter_type = "LS" + ELSE + iter_type = "CG" ENDIF - outer_iteration = outer_iteration+1 - IF (outer_prepare_to_exit) EXIT - - ENDDO ! outer SCF loop - - ! post SCF-loop calculations - IF (converged) THEN - - ! RZK-warning: must obtain MO coefficients from final theta - - IF (perturbation_only) THEN - - ! compute Fvo for the zero-delocalization state - CALL dbcsr_create(fvo_0, & - template=matrix_t_out(ispin), & - matrix_type=dbcsr_type_no_symmetry) - CALL compute_frequently_used_matrices( & - filter_eps=almo_scf_env%eps_filter, & - m_T_in=almo_scf_env%matrix_t_blk(ispin), & - m_siginv_in=almo_scf_env%matrix_sigma_inv_0deloc(ispin), & - m_S_in=almo_scf_env%matrix_s(1), & - m_F_in=almo_scf_env%matrix_ks_0deloc(ispin), & - m_FTsiginv_out=FTsiginv, & - m_siginvTFTsiginv_out=siginvTFTsiginv, & - m_ST_out=ST) - CALL dbcsr_copy(fvo_0, quench_t(ispin)) - CALL dbcsr_copy(fvo_0, FTsiginv, keep_sparsity=.TRUE.) - CALL dbcsr_multiply("N", "N", -1.0_dp, & - ST, & - siginvTFTsiginv, & - 1.0_dp, fvo_0, & - retain_sparsity=.TRUE.) - - ! use step matrix to store excitation amplitudes - CALL dbcsr_copy(step, almo_scf_env%matrix_t_blk(ispin)) - CALL dbcsr_add(step, matrix_t_out(ispin), & - -1.0_dp, 1.0_dp) - - CALL dbcsr_scale(fvo_0, spin_factor) - CALL dbcsr_trace(step, fvo_0, energy_new) - - !CALL dbcsr_add(almo_scf_env%matrix_t_blk(ispin),matrix_t_out(ispin),& - ! -1.0_dp,1.0_dp) - !CALL dbcsr_trace(almo_scf_env%matrix_t_blk(ispin),& - ! fvo_0,energy_new,"T","N") - - ! print out the energy lowering - IF (unit_nr > 0) THEN - WRITE (unit_nr, *) - WRITE (unit_nr, '(T2,A35,F25.10)') "ENERGY OF BLOCK-DIAGONAL ALMOs:", & - almo_scf_env%almo_scf_energy - WRITE (unit_nr, '(T2,A35,F25.10)') "ENERGY LOWERING:", & - energy_new - WRITE (unit_nr, '(T2,A35,F25.10)') "CORRECTED ENERGY:", & - almo_scf_env%almo_scf_energy+energy_new - WRITE (unit_nr, *) + t2 = m_walltime() + IF (unit_nr > 0) THEN + iter_type = TRIM("ALMO SCF "//iter_type) + WRITE (unit_nr, '(T2,A13,I6,F23.10,E14.5,F14.9,F9.2)') & + iter_type, iteration, & + energy_new, energy_diff, grad_norm, & + t2-t1 + IF (penalty_occ_vol) THEN + WRITE (unit_nr, '(T2,A19,F23.10)') & + "Energy component:", energy_new-penalty_func_new + WRITE (unit_nr, '(T2,A19,F23.10)') & + "Penalty component:", penalty_func_new ENDIF - CALL almo_scf_update_ks_energy(qs_env, & - energy=almo_scf_env%almo_scf_energy, & - energy_singles_corr=energy_new) + ENDIF - IF (almo_scf_env%almo_analysis%do_analysis) THEN + IF (my_special_case .EQ. xalmo_case_block_diag) THEN + IF (penalty_occ_vol) THEN + almo_scf_env%almo_scf_energy = energy_new-penalty_func_new + ELSE + almo_scf_env%almo_scf_energy = energy_new + ENDIF + ENDIF + + t1 = m_walltime() + + iteration = iteration+1 + IF (prepare_to_exit) EXIT + + ENDDO ! inner SCF loop + + IF (converged .OR. (outer_iteration .GE. outer_max_iter)) THEN + outer_prepare_to_exit = .TRUE. + ENDIF + + outer_iteration = outer_iteration+1 + IF (outer_prepare_to_exit) EXIT + + ENDDO ! outer SCF loop + + DO ispin = 1, nspins + IF (converged .AND. almo_mathematica) THEN + IF (ispin .GT. 1) CPWARN("Mathematica files will be overwritten") + CALL print_mathematica_matrix(matrix_t_out(ispin), "matrixTf.dat") + ENDIF + ENDDO ! ispin + + ! post SCF-loop calculations + IF (converged) THEN + + ! RZK-warning: must obtain MO coefficients from final theta + + IF (perturbation_only) THEN + + ! return perturbed density to qs_env + CALL almo_dm_to_qs_env(qs_env, almo_scf_env%matrix_p, & + almo_scf_env%mat_distr_aos) + + ! compute energy correction and perform + ! detailed decomposition analysis (if requested) + ! reuse step and grad matrices to store decomposition results + CALL xalmo_analysis( & + detailed_analysis=almo_scf_env%almo_analysis%do_analysis, & + eps_filter=almo_scf_env%eps_filter, & + m_T_in=matrix_t_out(:), & + m_T0_in=almo_scf_env%matrix_t_blk(:), & + m_siginv_in=almo_scf_env%matrix_sigma_inv(:), & + m_siginv0_in=almo_scf_env%matrix_sigma_inv_0deloc(:), & + m_S_in=almo_scf_env%matrix_s(:), & + m_KS0_in=almo_scf_env%matrix_ks_0deloc(:), & + m_quench_t_in=quench_t(:), & + energy_out=energy_new, & + m_eda_out=step(:), & + m_cta_out=grad(:) & + ) + + IF (almo_scf_env%almo_analysis%do_analysis) THEN + + DO ispin = 1, nspins ! energy decomposition analysis (EDA) IF (unit_nr > 0) THEN WRITE (unit_nr, '(T2,A)') "DECOMPOSITION OF THE DELOCALIZATION ENERGY" ENDIF - CALL dbcsr_hadamard_product(step, & - fvo_0, m_tmp_no_1) - !CALL dbcsr_hadamard_product(almo_scf_env%matrix_t_blk(ispin), & - ! fvo_0,m_tmp_no_1) - CALL dbcsr_filter(m_tmp_no_1, almo_scf_env%eps_filter) - ! open the output file, print and close CALL get_qs_env(qs_env, input=input) almo_print_section => section_vals_get_subs_vals(input, "DFT%ALMO_SCF%ANALYSIS%PRINT") eda_unit = cp_print_key_unit_nr(logger, almo_print_section, & "ALMO_EDA_CT", extension=".dat", local=.TRUE.) - CALL dbcsr_print_block_sum(m_tmp_no_1, eda_unit) + CALL dbcsr_print_block_sum(step(ispin), eda_unit) CALL cp_print_key_finished_output(eda_unit, logger, almo_print_section, & "ALMO_EDA_CT", local=.TRUE.) @@ -1988,107 +1805,238 @@ CONTAINS WRITE (unit_nr, '(T2,A)') "DECOMPOSITION OF CHARGE TRANSFER TERMS" ENDIF - ! first, compute [QR'R]_mu^i = [(S-SRS).X.siginv']_mu^i - ! a. STsiginv_0 = S.T0*siginv0 - CALL dbcsr_multiply("N", "N", 1.0_dp, & - ST, & - almo_scf_env%matrix_sigma_inv_0deloc(ispin), & - 0.0_dp, STsiginv_0, & - filter_eps=almo_scf_env%eps_filter) - ! c. tmp1 = S.X - CALL dbcsr_multiply("N", "N", 1.0_dp, & - almo_scf_env%matrix_s(1), & - step, & - 0.0_dp, m_tmp_no_1, & - filter_eps=almo_scf_env%eps_filter) - ! d. tmp2 = tr(T0).tmp1 = tr(T0).S.X - CALL dbcsr_multiply("T", "N", 1.0_dp, & - almo_scf_env%matrix_t_blk(ispin), & - m_tmp_no_1, & - 0.0_dp, m_tmp_oo_1, & - filter_eps=almo_scf_env%eps_filter) - ! e. tmp1 = tmp1 - tmp3.tmp2 = S.X - S.T0.siginv0*tr(T0).S.X - ! = (1-S.R0).S.X - CALL dbcsr_multiply("N", "N", -1.0_dp, & - STsiginv_0, & - m_tmp_oo_1, & - 1.0_dp, m_tmp_no_1, & - filter_eps=almo_scf_env%eps_filter) - ! f. tmp2 = tmp1*siginv - CALL dbcsr_multiply("N", "N", 1.0_dp, & - m_tmp_no_1, & - almo_scf_env%matrix_sigma_inv(ispin), & - 0.0_dp, m_tmp_no_2, & - filter_eps=almo_scf_env%eps_filter) - ! second, compute traces of blocks [RR'Q]^x_y * [X]^y_x - CALL dbcsr_hadamard_product(step, & - m_tmp_no_2, m_tmp_no_1) - CALL dbcsr_scale(m_tmp_no_1, spin_factor) - CALL dbcsr_filter(m_tmp_no_1, almo_scf_env%eps_filter) - eda_unit = cp_print_key_unit_nr(logger, almo_print_section, & "ALMO_CTA", extension=".dat", local=.TRUE.) - CALL dbcsr_print_block_sum(m_tmp_no_1, eda_unit) + CALL dbcsr_print_block_sum(grad(ispin), eda_unit) CALL cp_print_key_finished_output(eda_unit, logger, almo_print_section, & "ALMO_CTA", local=.TRUE.) - ENDIF ! do ALMO EDA/CTA + ENDDO ! ispin - CALL dbcsr_release(fvo_0) + ENDIF ! do ALMO EDA/CTA - ELSE + ! print out the energy lowering + IF (unit_nr > 0) THEN + WRITE (unit_nr, *) + WRITE (unit_nr, '(T2,A35,F25.10)') "ENERGY OF BLOCK-DIAGONAL ALMOs:", & + almo_scf_env%almo_scf_energy + WRITE (unit_nr, '(T2,A35,F25.10)') "ENERGY LOWERING:", & + energy_new + WRITE (unit_nr, '(T2,A35,F25.10)') "CORRECTED ENERGY:", & + almo_scf_env%almo_scf_energy+energy_new + WRITE (unit_nr, *) + ENDIF + CALL almo_scf_update_ks_energy(qs_env, & + energy=almo_scf_env%almo_scf_energy, & + energy_singles_corr=energy_new) - CALL almo_scf_update_ks_energy(qs_env, & - energy=energy_new) + ELSE ! non-perturbative - ENDIF ! if perturbation only + CALL almo_scf_update_ks_energy(qs_env, & + energy=energy_new) - !CALL qs_ks_update_qs_env(qs_env, & - ! calculate_forces=.FALSE., & - ! just_energy=.TRUE., & - ! print_active=.TRUE.) + ENDIF ! if perturbation only - ENDIF ! if converged - - IF (md_in_theta_space) THEN - CALL dbcsr_release(velocity) - ENDIF - CALL dbcsr_release(prec_vv) - CALL dbcsr_release(prec_oo) - CALL dbcsr_release(prec_oo_inv) - CALL dbcsr_release(m_tmp_no_1) - CALL dbcsr_release(STsiginv_0) - CALL dbcsr_release(m_tmp_no_2) - CALL dbcsr_release(m_tmp_no_3) - CALL dbcsr_release(m_tmp_oo_1) - CALL dbcsr_release(ST) - CALL dbcsr_release(FTsiginv) - CALL dbcsr_release(siginvTFTsiginv) - CALL dbcsr_release(m_tmp_nn_1) - CALL dbcsr_release(prev_grad) - CALL dbcsr_release(prev_step) - CALL dbcsr_release(grad) - CALL dbcsr_release(step) - CALL dbcsr_release(prev_minus_prec_grad) - - IF (.NOT. converged) THEN - CPABORT("Optimization not converged! ") - ENDIF - - DEALLOCATE (domain_r_down) - - ENDDO ! ispin + ENDIF ! if converged DO ispin = 1, nspins + CALL dbcsr_release(prec_vv(ispin)) + CALL dbcsr_release(STsiginv_0(ispin)) + CALL dbcsr_release(ST(ispin)) + CALL dbcsr_release(FTsiginv(ispin)) + CALL dbcsr_release(siginvTFTsiginv(ispin)) + CALL dbcsr_release(prev_grad(ispin)) + CALL dbcsr_release(prev_step(ispin)) + CALL dbcsr_release(grad(ispin)) + CALL dbcsr_release(step(ispin)) + CALL dbcsr_release(prev_minus_prec_grad(ispin)) CALL dbcsr_release(m_theta(ispin)) CALL dbcsr_release(m_t_in_local(ispin)) + CALL dbcsr_release(m_sig_sqrti_ii(ispin)) + CALL release_submatrices(domain_r_down(:, ispin)) + CALL release_submatrices(bad_modes_projector_down(:, ispin)) ENDDO ! ispin + + DEALLOCATE (prec_vv) + DEALLOCATE (siginvTFTsiginv) + DEALLOCATE (STsiginv_0) + DEALLOCATE (FTsiginv) + DEALLOCATE (ST) + DEALLOCATE (prev_grad) + DEALLOCATE (grad) + DEALLOCATE (prev_step) + DEALLOCATE (step) + DEALLOCATE (prev_minus_prec_grad) + DEALLOCATE (m_sig_sqrti_ii) + + DEALLOCATE (domain_r_down) + DEALLOCATE (bad_modes_projector_down) + + DEALLOCATE (penalty_occ_vol_g_prefactor) + DEALLOCATE (penalty_occ_vol_h_prefactor) + DEALLOCATE (grad_norm_spin) + DEALLOCATE (nocc) + DEALLOCATE (m_theta, m_t_in_local) + IF (.NOT. converged .AND. .NOT. optimizer%early_stopping_on) THEN + CPABORT("Optimization not converged! ") + ENDIF + CALL timestop(handle) END SUBROUTINE almo_scf_xalmo_pcg +! ************************************************************************************************** +!> \brief Analysis of the orbitals +!> \param detailed_analysis ... +!> \param eps_filter ... +!> \param m_T_in ... +!> \param m_T0_in ... +!> \param m_siginv_in ... +!> \param m_siginv0_in ... +!> \param m_S_in ... +!> \param m_KS0_in ... +!> \param m_quench_t_in ... +!> \param energy_out ... +!> \param m_eda_out ... +!> \param m_cta_out ... +!> \par History +!> 2017.07 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE xalmo_analysis(detailed_analysis, eps_filter, m_T_in, m_T0_in, & + m_siginv_in, m_siginv0_in, m_S_in, m_KS0_in, m_quench_t_in, energy_out, & + m_eda_out, m_cta_out) + + LOGICAL, INTENT(IN) :: detailed_analysis + REAL(KIND=dp), INTENT(IN) :: eps_filter + TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_T_in, m_T0_in, m_siginv_in, & + m_siginv0_in, m_S_in, m_KS0_in, & + m_quench_t_in + REAL(KIND=dp), INTENT(INOUT) :: energy_out + TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_eda_out, m_cta_out + + CHARACTER(len=*), PARAMETER :: routineN = 'xalmo_analysis', routineP = moduleN//':'//routineN + + INTEGER :: handle, ispin, nspins + REAL(KIND=dp) :: energy_ispin, spin_factor + TYPE(dbcsr_type) :: FTsiginv0, Fvo0, m_X, siginvTFTsiginv0, & + ST0 + + CALL timeset(routineN, handle) + + nspins = SIZE(m_T_in) + + IF (nspins == 1) THEN + spin_factor = 2.0_dp + ELSE + spin_factor = 1.0_dp + ENDIF + + energy_out = 0.0_dp + DO ispin = 1, nspins + + ! create temporary matrices + CALL dbcsr_create(Fvo0, & + template=m_T_in(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(FTsiginv0, & + template=m_T_in(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(ST0, & + template=m_T_in(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_X, & + template=m_T_in(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(siginvTFTsiginv0, & + template=m_siginv0_in(ispin), & + matrix_type=dbcsr_type_no_symmetry) + + ! compute F_{virt,occ} for the zero-delocalization state + CALL compute_frequently_used_matrices( & + filter_eps=eps_filter, & + m_T_in=m_T0_in(ispin), & + m_siginv_in=m_siginv0_in(ispin), & + m_S_in=m_S_in(1), & + m_F_in=m_KS0_in(ispin), & + m_FTsiginv_out=FTsiginv0, & + m_siginvTFTsiginv_out=siginvTFTsiginv0, & + m_ST_out=ST0) + CALL dbcsr_copy(Fvo0, m_quench_t_in(ispin)) + CALL dbcsr_copy(Fvo0, FTsiginv0, keep_sparsity=.TRUE.) + CALL dbcsr_multiply("N", "N", -1.0_dp, & + ST0, & + siginvTFTsiginv0, & + 1.0_dp, Fvo0, & + retain_sparsity=.TRUE.) + + ! get single excitation amplitudes + CALL dbcsr_copy(m_X, m_T0_in(ispin)) + CALL dbcsr_add(m_X, m_T_in(ispin), -1.0_dp, 1.0_dp) + + CALL dbcsr_trace(m_X, Fvo0, energy_ispin) + energy_out = energy_out+energy_ispin*spin_factor + + IF (detailed_analysis) THEN + + CALL dbcsr_hadamard_product(m_X, Fvo0, m_eda_out(ispin)) + CALL dbcsr_scale(m_eda_out(ispin), spin_factor) + CALL dbcsr_filter(m_eda_out(ispin), eps_filter) + + ! first, compute [QR'R]_mu^i = [(S-SRS).X.siginv']_mu^i + ! a. FTsiginv0 = S.T0*siginv0 + CALL dbcsr_multiply("N", "N", 1.0_dp, & + ST0, & + m_siginv0_in(ispin), & + 0.0_dp, FTsiginv0, & + filter_eps=eps_filter) + ! c. tmp1(use ST0) = S.X + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_S_in(1), & + m_X, & + 0.0_dp, ST0, & + filter_eps=eps_filter) + ! d. tmp2 = tr(T0).tmp1 = tr(T0).S.X + CALL dbcsr_multiply("T", "N", 1.0_dp, & + m_T0_in(ispin), & + ST0, & + 0.0_dp, siginvTFTsiginv0, & + filter_eps=eps_filter) + ! e. tmp1 = tmp1 - tmp3.tmp2 = S.X - S.T0.siginv0*tr(T0).S.X + ! = (1-S.R0).S.X + CALL dbcsr_multiply("N", "N", -1.0_dp, & + FTsiginv0, & + siginvTFTsiginv0, & + 1.0_dp, ST0, & + filter_eps=eps_filter) + ! f. tmp2(use FTsiginv0) = tmp1*siginv + CALL dbcsr_multiply("N", "N", 1.0_dp, & + ST0, & + m_siginv_in(ispin), & + 0.0_dp, FTsiginv0, & + filter_eps=eps_filter) + ! second, compute traces of blocks [RR'Q]^x_y * [X]^y_x + CALL dbcsr_hadamard_product(m_X, & + FTsiginv0, m_cta_out(ispin)) + CALL dbcsr_scale(m_cta_out(ispin), spin_factor) + CALL dbcsr_filter(m_cta_out(ispin), eps_filter) + + ENDIF ! do ALMO EDA/CTA + + CALL dbcsr_release(Fvo0) + CALL dbcsr_release(FTsiginv0) + CALL dbcsr_release(ST0) + CALL dbcsr_release(m_X) + CALL dbcsr_release(siginvTFTsiginv0) + + ENDDO ! ispin + + CALL timestop(handle) + + END SUBROUTINE xalmo_analysis + ! ************************************************************************************************** !> \brief Compute matrices that are used often in various parts of the !> optimization procedure @@ -3698,13 +3646,22 @@ CONTAINS ! obtain density matrix from updated MOs ! RZK-later sigma and sigma_inv are lost here - CALL almo_scf_t_to_p(t=almo_scf_env%matrix_t(ispin), & - p=almo_scf_env%matrix_p(ispin), & - eps_filter=almo_scf_env%eps_filter, & - orthog_orbs=.FALSE., & - s=almo_scf_env%matrix_s(1), & - sigma=almo_scf_env%matrix_sigma(ispin), & - sigma_inv=almo_scf_env%matrix_sigma_inv(ispin)) + CALL almo_scf_t_to_proj(t=almo_scf_env%matrix_t(ispin), & + p=almo_scf_env%matrix_p(ispin), & + eps_filter=almo_scf_env%eps_filter, & + orthog_orbs=.FALSE., & + nocc_of_domain=almo_scf_env%nocc_of_domain(:, ispin), & + s=almo_scf_env%matrix_s(1), & + sigma=almo_scf_env%matrix_sigma(ispin), & + sigma_inv=almo_scf_env%matrix_sigma_inv(ispin), & + !use_guess=use_guess, & + algorithm=almo_scf_env%sigma_inv_algorithm, & + inverse_accelerator=almo_scf_env%order_lanczos, & + inv_eps_factor=almo_scf_env%matrix_iter_eps_error_factor, & + eps_lanczos=almo_scf_env%eps_lanczos, & + max_iter_lanczos=almo_scf_env%max_iter_lanczos, & + para_env=almo_scf_env%para_env, & + blacs_env=almo_scf_env%blacs_env) IF (almo_scf_env%nspins == 1) & CALL dbcsr_scale(almo_scf_env%matrix_p(ispin), & @@ -4570,14 +4527,13 @@ CONTAINS !! right_vectors,iblock_col_size,WORK,LWORK,INFO) !! deallocate(WORK) !! IF( INFO.NE.0 ) THEN -!! CPErrorMessage(cp_failure_level,routineP,"DGESVD failed") -!! CPPrecondition(.FALSE.,cp_failure_level,routineP,failure) +!! CPABORT("DGESVD failed") !! END IF !! !! ! copy right singular vectors into a unitary matrix !! NULLIFY (p_new_block) !! CALL dbcsr_reserve_block2d(temp_u_v_full_blk,iblock_col,iblock_col,p_new_block) -!! CPPostcondition(ASSOCIATED(p_new_block),cp_failure_level,routineP,failure) +!! CPASSERT(ASSOCIATED(p_new_block)) !! p_new_block(:,:) = right_vectors(:,:) !! !! deallocate(eigenvalues) @@ -4855,8 +4811,8 @@ CONTAINS ! !CALL dbcsr_reserve_block2d(almo_scf_env%matrix_v_blk(ispin),& ! CALL dbcsr_reserve_block2d(almo_scf_env%matrix_v(ispin),& ! iblock_row,iblock_col,p_new_block) -! CPPostcondition(ASSOCIATED(p_new_block),cp_failure_level,routineP,failure) -! CPPrecondition(retained_v.gt.0,cp_failure_level,routineP,failure) +! CPASSERT(ASSOCIATED(p_new_block)) +! CPASSERT(retained_v.gt.0) ! p_new_block(:,:) = data_p(:,1:retained_v) ! ! ENDDO ! iterator @@ -4892,7 +4848,6 @@ CONTAINS !> \param domain_map ... !> \param assume_t0_q0x ... !> \param optimize_theta ... -!> \param perturbation_only ... !> \param normalize_orbitals ... !> \param penalty_occ_vol ... !> \param penalty_occ_vol_prefactor ... @@ -4909,7 +4864,7 @@ CONTAINS m_siginv, m_quench_t, m_FTsiginv, m_siginvTFTsiginv, m_ST, m_STsiginv0, & m_theta, domain_s_inv, domain_r_down, & cpu_of_domain, domain_map, assume_t0_q0x, optimize_theta, & - perturbation_only, normalize_orbitals, penalty_occ_vol, & + normalize_orbitals, penalty_occ_vol, & penalty_occ_vol_prefactor, envelope_amplitude, eps_filter, spin_factor, & special_case, m_sig_sqrti_ii) @@ -4923,8 +4878,7 @@ CONTAINS INTEGER, DIMENSION(:), INTENT(IN) :: cpu_of_domain TYPE(domain_map_type), INTENT(IN) :: domain_map LOGICAL, INTENT(IN) :: assume_t0_q0x, optimize_theta, & - perturbation_only, normalize_orbitals, & - penalty_occ_vol + normalize_orbitals, penalty_occ_vol REAL(KIND=dp), INTENT(IN) :: penalty_occ_vol_prefactor, & envelope_amplitude, eps_filter, & spin_factor @@ -4944,14 +4898,13 @@ CONTAINS CALL timeset(routineN, handle) IF (normalize_orbitals .AND. (.NOT. PRESENT(m_sig_sqrti_ii))) THEN - CPABORT("Matrix must be present") + CPABORT("Normalization matrix is required") ENDIF ! use this otherways unused variables CALL dbcsr_get_info(matrix=m_ks, nfullrows_total=nao) CALL dbcsr_get_info(matrix=m_s, nfullrows_total=nao) CALL dbcsr_get_info(matrix=m_t, nfullrows_total=nao) - IF (perturbation_only) CPWARN("Unused option") CALL dbcsr_create(m_tmp_no_1, & template=m_quench_t, & @@ -5059,7 +5012,7 @@ CONTAINS retain_sparsity=.TRUE.) !!! slower way of taking the norm into account - !!CALL dbcsr_copy(m_tmp_no_1,m_tmp_no_2,) + !!CALL dbcsr_copy(m_tmp_no_1,m_tmp_no_2) !!CALL dbcsr_multiply("N","N",1.0_dp,& !! m_tmp_no_2,& !! m_sig_sqrti_ii,& @@ -5068,7 +5021,7 @@ CONTAINS !! ) !! !!! get [tr(T).G]_ii - !!CALL dbcsr_copy(m_tmp_oo_1,m_sig_sqrti_ii,) + !!CALL dbcsr_copy(m_tmp_oo_1,m_sig_sqrti_ii) !!CALL dbcsr_multiply("T","N",1.0_dp,& !! m_t,& !! m_tmp_no_2,& @@ -5077,9 +5030,9 @@ CONTAINS !! ) !!CALL dbcsr_get_info(m_sig_sqrti_ii, nfullrows_total=dim0 ) !!ALLOCATE(tg_diagonal(dim0)) - !!CALL dbcsr_get_diag(m_tmp_oo_1,tg_diagonal,) - !!CALL dbcsr_set(m_tmp_oo_1,0.0_dp,) - !!CALL dbcsr_set_diag(m_tmp_oo_1,tg_diagonal,) + !!CALL dbcsr_get_diag(m_tmp_oo_1,tg_diagonal) + !!CALL dbcsr_set(m_tmp_oo_1,0.0_dp) + !!CALL dbcsr_set_diag(m_tmp_oo_1,tg_diagonal) !!DEALLOCATE(tg_diagonal) !! !!CALL dbcsr_multiply("N","N",1.0_dp,& @@ -5148,7 +5101,7 @@ CONTAINS ! 0.0_dp,m_tmp_oo_2,& ! filter_eps=eps_filter,& ! ) - !CALL dbcsr_copy(m_tmp_no_2,m_tmp_no_1,) + !CALL dbcsr_copy(m_tmp_no_2,m_tmp_no_1) !CALL dbcsr_multiply("N","N",-1.0_dp,& ! m_ST,& ! m_tmp_oo_2,& @@ -5158,7 +5111,7 @@ CONTAINS !CALL dbcsr_norm(m_tmp_no_2, dbcsr_norm_maxabsnorm,& ! norm_scalar=penalty_occ_vol_g_norm, ) !WRITE(*,"(A50,2F20.10)") "Virtual-space projection of the gradient", penalty_occ_vol_g_norm - !CALL dbcsr_add(m_tmp_no_2,m_tmp_no_1,1.0_dp,-1.0_dp,) + !CALL dbcsr_add(m_tmp_no_2,m_tmp_no_1,1.0_dp,-1.0_dp) !CALL dbcsr_norm(m_tmp_no_2, dbcsr_norm_maxabsnorm,& ! norm_scalar=penalty_occ_vol_g_norm, ) !WRITE(*,"(A50,2F20.10)") "Occupied-space projection of the gradient", penalty_occ_vol_g_norm @@ -5202,5 +5155,2367 @@ CONTAINS END SUBROUTINE compute_gradient +! ***************************************************************************** +!> \brief Serial code that prints matrices readable by Mathematica +!> \param matrix - matrix to print +!> \param filename ... +!> \par History +!> 2015.05 created [Rustam Z. Khaliullin] +!> \author Rustam Z. Khaliullin +! ************************************************************************************************** + SUBROUTINE print_mathematica_matrix(matrix, filename) + + TYPE(dbcsr_type), INTENT(INOUT) :: matrix + CHARACTER(len=*) :: filename + + CHARACTER(len=*), PARAMETER :: routineN = 'print_mathematica_matrix', & + routineP = moduleN//':'//routineN + + CHARACTER(LEN=20) :: formatstr, Scols + CHARACTER(LEN=200) :: logfile + INTEGER :: col, fiunit, handle, hori_offset, jj, & + nblkcols_tot, nblkrows_tot, Ncols, & + ncores, Nrows, row, unit_nr, & + vert_offset + INTEGER, ALLOCATABLE, DIMENSION(:) :: ao_block_sizes, mo_block_sizes + INTEGER, DIMENSION(:), POINTER :: ao_blk_sizes, mo_blk_sizes + LOGICAL :: found + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: H + REAL(KIND=dp), DIMENSION(:, :), POINTER :: block_p + TYPE(cp_logger_type), POINTER :: logger + TYPE(dbcsr_distribution_type) :: dist + TYPE(dbcsr_type) :: matrix_asym + + CALL timeset(routineN, handle) + + ! get a useful output_unit + logger => cp_get_default_logger() + IF (logger%para_env%mepos == logger%para_env%source) THEN + unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.) + ELSE + unit_nr = -1 + ENDIF + + ! serial code only + CALL dbcsr_get_info(matrix, distribution=dist) + CALL dbcsr_distribution_get(dist, numnodes=ncores) + IF (ncores .GT. 1) THEN + CPABORT("mathematica files: serial code only") + ENDIF + + nblkrows_tot = dbcsr_nblkrows_total(matrix) + nblkcols_tot = dbcsr_nblkcols_total(matrix) + CPASSERT(nblkrows_tot == nblkcols_tot) + CALL dbcsr_get_info(matrix, row_blk_size=ao_blk_sizes) + CALL dbcsr_get_info(matrix, col_blk_size=mo_blk_sizes) + ALLOCATE (mo_block_sizes(nblkcols_tot), ao_block_sizes(nblkcols_tot)) + mo_block_sizes(:) = mo_blk_sizes(:) + ao_block_sizes(:) = ao_blk_sizes(:) + + CALL dbcsr_create(matrix_asym, & + template=matrix, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_desymmetrize(matrix, matrix_asym) + + Ncols = SUM(mo_block_sizes) + Nrows = SUM(ao_block_sizes) + ALLOCATE (H(Nrows, Ncols)) + H(:, :) = 0.0_dp + + hori_offset = 0 + DO col = 1, nblkcols_tot + + vert_offset = 0 + DO row = 1, nblkrows_tot + + CALL dbcsr_get_block_p(matrix_asym, row, col, block_p, found) + IF (found) THEN + + H(vert_offset+1:vert_offset+ao_block_sizes(row), & + hori_offset+1:hori_offset+mo_block_sizes(col)) & + = block_p(:, :) + + ENDIF + + vert_offset = vert_offset+ao_block_sizes(row) + + ENDDO + + hori_offset = hori_offset+mo_block_sizes(col) + + ENDDO ! loop over electron blocks + + CALL dbcsr_release(matrix_asym) + + IF (unit_nr > 0) THEN + logfile = TRIM(ADJUSTL(filename)) + OPEN (fiunit, file=logfile, status='REPLACE') + WRITE (Scols, "(I10)") Ncols + formatstr = "("//TRIM(Scols)//"E27.17)" + DO jj = 1, Nrows + WRITE (fiunit, formatstr) H(jj, :) + ENDDO + CLOSE (fiunit) + ENDIF + + DEALLOCATE (mo_block_sizes) + DEALLOCATE (ao_block_sizes) + DEALLOCATE (H) + + CALL timestop(handle) + + END SUBROUTINE print_mathematica_matrix + +! ***************************************************************************** +!> \brief Compute MO coeffs from the main optimized variable (e.g. Theta, X) +!> \param m_var_in ... +!> \param m_t_out ... +!> \param m_quench_t ... +!> \param m_t0 ... +!> \param m_siginv ... +!> \param m_STsiginv0 ... +!> \param m_s ... +!> \param m_sig_sqrti_ii_out ... +!> \param domain_r_down ... +!> \param domain_s_inv ... +!> \param domain_map ... +!> \param cpu_of_domain ... +!> \param assume_t0_q0x ... +!> \param just_started ... +!> \param optimize_theta ... +!> \param normalize_orbitals ... +!> \param envelope_amplitude ... +!> \param eps_filter ... +!> \param special_case ... +!> \param nocc_of_domain ... +!> \param order_lanczos ... +!> \param eps_lanczos ... +!> \param max_iter_lanczos ... +!> \par History +!> 2015.03 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE compute_xalmos_from_main_var(m_var_in, m_t_out, m_quench_t, & + m_t0, m_siginv, m_STsiginv0, m_s, m_sig_sqrti_ii_out, domain_r_down, & + domain_s_inv, domain_map, cpu_of_domain, assume_t0_q0x, just_started, & + optimize_theta, normalize_orbitals, envelope_amplitude, eps_filter, & + special_case, nocc_of_domain, order_lanczos, eps_lanczos, max_iter_lanczos) + + TYPE(dbcsr_type), INTENT(IN) :: m_var_in + TYPE(dbcsr_type), INTENT(INOUT) :: m_t_out, m_quench_t + TYPE(dbcsr_type), INTENT(IN) :: m_t0 + TYPE(dbcsr_type), INTENT(INOUT) :: m_siginv + TYPE(dbcsr_type), INTENT(IN) :: m_STsiginv0, m_s + TYPE(dbcsr_type), INTENT(INOUT) :: m_sig_sqrti_ii_out + TYPE(domain_submatrix_type), DIMENSION(:), & + INTENT(IN) :: domain_r_down, domain_s_inv + TYPE(domain_map_type), INTENT(IN) :: domain_map + INTEGER, DIMENSION(:), INTENT(IN) :: cpu_of_domain + LOGICAL, INTENT(IN) :: assume_t0_q0x, just_started, & + optimize_theta, normalize_orbitals + REAL(KIND=dp), INTENT(IN) :: envelope_amplitude, eps_filter + INTEGER, INTENT(IN) :: special_case + INTEGER, DIMENSION(:), INTENT(IN) :: nocc_of_domain + INTEGER, INTENT(IN) :: order_lanczos + REAL(KIND=dp), INTENT(IN) :: eps_lanczos + INTEGER, INTENT(IN) :: max_iter_lanczos + + CHARACTER(len=*), PARAMETER :: routineN = 'compute_xalmos_from_main_var', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, unit_nr + REAL(KIND=dp) :: t_norm + TYPE(cp_logger_type), POINTER :: logger + TYPE(dbcsr_type) :: m_tmp_no_1, m_tmp_oo_1 + + CALL timeset(routineN, handle) + + ! get a useful output_unit + logger => cp_get_default_logger() + IF (logger%para_env%mepos == logger%para_env%source) THEN + unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.) + ELSE + unit_nr = -1 + ENDIF + + CALL dbcsr_create(m_tmp_no_1, & + template=m_quench_t, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_tmp_oo_1, & + template=m_siginv, & + matrix_type=dbcsr_type_no_symmetry) + + CALL dbcsr_copy(m_tmp_no_1, m_var_in) + IF (optimize_theta) THEN + ! check that all MO coefficients of the guess are less + ! than the maximum allowed amplitude + CALL dbcsr_norm(m_tmp_no_1, & + dbcsr_norm_maxabsnorm, norm_scalar=t_norm) + IF (unit_nr > 0) THEN + WRITE (unit_nr, *) "Maximum norm of the initial guess: ", t_norm + WRITE (unit_nr, *) "Maximum allowed amplitude: ", & + envelope_amplitude + ENDIF + IF (t_norm .GT. envelope_amplitude .AND. just_started) THEN + CPABORT("Max norm of the initial guess is too large") + ENDIF + ! use artanh to tame MOs + CALL dbcsr_function_of_elements(m_tmp_no_1, & + func=dbcsr_func_tanh, & + a0=0.0_dp, & + a1=1.0_dp/envelope_amplitude) + CALL dbcsr_scale(m_tmp_no_1, & + envelope_amplitude) + ENDIF + CALL dbcsr_hadamard_product(m_tmp_no_1, m_quench_t, & + m_t_out) + + ! project out R_0 + IF (assume_t0_q0x) THEN + IF (special_case .EQ. xalmo_case_fully_deloc) THEN + CALL dbcsr_multiply("T", "N", 1.0_dp, & + m_STsiginv0, & + m_t_out, & + 0.0_dp, m_tmp_oo_1, & + filter_eps=eps_filter) + CALL dbcsr_multiply("N", "N", -1.0_dp, & + m_t0, & + m_tmp_oo_1, & + 1.0_dp, m_t_out, & + filter_eps=eps_filter) + ELSE IF (special_case .EQ. xalmo_case_block_diag) THEN + CPABORT("cannot use projector with block-daigonal ALMOs") + ELSE + ! no special case + CALL apply_domain_operators( & + matrix_in=m_t_out, & + matrix_out=m_tmp_no_1, & + operator1=domain_r_down, & + operator2=domain_s_inv, & + dpattern=m_quench_t, & + map=domain_map, & + node_of_domain=cpu_of_domain, & + my_action=1, & + filter_eps=eps_filter, & + use_trimmer=.FALSE.) + CALL dbcsr_copy(m_t_out, & + m_tmp_no_1) + ENDIF ! special case + CALL dbcsr_add(m_t_out, & + m_t0, 1.0_dp, 1.0_dp) + ENDIF + + IF (normalize_orbitals) THEN + CALL orthogonalize_mos( & + ket=m_t_out, & + overlap=m_tmp_oo_1, & + metric=m_s, & + retain_locality=.TRUE., & + only_normalize=.TRUE., & + nocc_of_domain=nocc_of_domain(:), & + eps_filter=eps_filter, & + order_lanczos=order_lanczos, & + eps_lanczos=eps_lanczos, & + max_iter_lanczos=max_iter_lanczos, & + overlap_sqrti=m_sig_sqrti_ii_out) + ENDIF + + CALL dbcsr_filter(m_t_out, eps=eps_filter) + + CALL dbcsr_release(m_tmp_no_1) + CALL dbcsr_release(m_tmp_oo_1) + + CALL timestop(handle) + + END SUBROUTINE compute_xalmos_from_main_var + +! ***************************************************************************** +!> \brief Compute the preconditioner matrices and invert them if necessary +!> \param domain_prec_out ... +!> \param m_prec_out ... +!> \param m_ks ... +!> \param m_s ... +!> \param m_siginv ... +!> \param m_quench_t ... +!> \param m_FTsiginv ... +!> \param m_siginvTFTsiginv ... +!> \param m_ST ... +!> \param m_STsiginv_out ... +!> \param m_s_vv_out ... +!> \param m_f_vv_out ... +!> \param para_env ... +!> \param blacs_env ... +!> \param nocc_of_domain ... +!> \param domain_s_inv ... +!> \param domain_s_inv_half ... +!> \param domain_s_half ... +!> \param domain_r_down ... +!> \param cpu_of_domain ... +!> \param domain_map ... +!> \param assume_t0_q0x ... +!> \param penalty_occ_vol ... +!> \param penalty_occ_vol_prefactor ... +!> \param eps_filter ... +!> \param neg_thr ... +!> \param spin_factor ... +!> \param special_case ... +!> \param bad_modes_projector_down_out ... +!> \par History +!> 2015.03 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE compute_preconditioner(domain_prec_out, m_prec_out, m_ks, m_s, & + m_siginv, m_quench_t, m_FTsiginv, m_siginvTFTsiginv, m_ST, & + m_STsiginv_out, m_s_vv_out, m_f_vv_out, para_env, & + blacs_env, nocc_of_domain, domain_s_inv, domain_s_inv_half, domain_s_half, & + domain_r_down, cpu_of_domain, & + domain_map, assume_t0_q0x, penalty_occ_vol, penalty_occ_vol_prefactor, & + eps_filter, neg_thr, spin_factor, special_case, bad_modes_projector_down_out) + + TYPE(domain_submatrix_type), DIMENSION(:), & + INTENT(INOUT) :: domain_prec_out + TYPE(dbcsr_type), INTENT(INOUT) :: m_prec_out, m_ks, m_s + TYPE(dbcsr_type), INTENT(IN) :: m_siginv + TYPE(dbcsr_type), INTENT(INOUT) :: m_quench_t + TYPE(dbcsr_type), INTENT(IN) :: m_FTsiginv, m_siginvTFTsiginv, m_ST + TYPE(dbcsr_type), INTENT(INOUT), OPTIONAL :: m_STsiginv_out, m_s_vv_out, m_f_vv_out + TYPE(cp_para_env_type), POINTER :: para_env + TYPE(cp_blacs_env_type), POINTER :: blacs_env + INTEGER, DIMENSION(:), INTENT(IN) :: nocc_of_domain + TYPE(domain_submatrix_type), DIMENSION(:), & + INTENT(IN) :: domain_s_inv + TYPE(domain_submatrix_type), DIMENSION(:), & + INTENT(IN), OPTIONAL :: domain_s_inv_half, domain_s_half + TYPE(domain_submatrix_type), DIMENSION(:), & + INTENT(IN) :: domain_r_down + INTEGER, DIMENSION(:), INTENT(IN) :: cpu_of_domain + TYPE(domain_map_type), INTENT(IN) :: domain_map + LOGICAL, INTENT(IN) :: assume_t0_q0x, penalty_occ_vol + REAL(KIND=dp), INTENT(IN) :: penalty_occ_vol_prefactor, eps_filter, & + neg_thr, spin_factor + INTEGER, INTENT(IN) :: special_case + TYPE(domain_submatrix_type), DIMENSION(:), & + INTENT(INOUT), OPTIONAL :: bad_modes_projector_down_out + + CHARACTER(len=*), PARAMETER :: routineN = 'compute_preconditioner', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, precond_domain_projector + TYPE(dbcsr_type) :: m_tmp_nn_1, m_tmp_no_3 + + CALL timeset(routineN, handle) + + CALL dbcsr_create(m_tmp_nn_1, & + template=m_s, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_tmp_no_3, & + template=m_quench_t, & + matrix_type=dbcsr_type_no_symmetry) + + ! calculate (1-R)F(1-R) and S-SRS + ! RZK-warning take advantage: some elements will be removed by the quencher + ! RZK-warning S operations can be performed outside the spin loop to save time + ! IT IS REQUIRED THAT PRECONDITIONER DOES NOT BREAK THE LOCALITY!!!! + ! RZK-warning: further optimization is ABSOLUTELY NECESSARY + + ! First S-SRS + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_ST, & + m_siginv, & + 0.0_dp, m_tmp_no_3, & + filter_eps=eps_filter) + CALL dbcsr_desymmetrize(m_s, m_tmp_nn_1) + ! return STsiginv if necessary + IF (PRESENT(m_STsiginv_out)) THEN + CALL dbcsr_copy(m_STsiginv_out, m_tmp_no_3) + ENDIF + IF (special_case .EQ. xalmo_case_fully_deloc) THEN + ! use S instead of S-SRS + ELSE + CALL dbcsr_multiply("N", "T", -1.0_dp, & + m_ST, & + m_tmp_no_3, & + 1.0_dp, m_tmp_nn_1, & + filter_eps=eps_filter) + ENDIF + ! return S_vv = (S or S-SRS) if necessary + IF (PRESENT(m_s_vv_out)) THEN + CALL dbcsr_copy(m_s_vv_out, m_tmp_nn_1) + ENDIF + + ! Second (1-R)F(1-R) + ! re-create matrix because desymmetrize is buggy - + ! it will create multiple copies of blocks + CALL dbcsr_desymmetrize(m_ks, m_prec_out) + CALL dbcsr_multiply("N", "T", -1.0_dp, & + m_FTsiginv, & + m_ST, & + 1.0_dp, m_prec_out, & + filter_eps=eps_filter) + CALL dbcsr_multiply("N", "T", -1.0_dp, & + m_ST, & + m_FTsiginv, & + 1.0_dp, m_prec_out, & + filter_eps=eps_filter) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_ST, & + m_siginvTFTsiginv, & + 0.0_dp, m_tmp_no_3, & + filter_eps=eps_filter) + CALL dbcsr_multiply("N", "T", 1.0_dp, & + m_tmp_no_3, & + m_ST, & + 1.0_dp, m_prec_out, & + filter_eps=eps_filter) + ! return F_vv = (I-SR)F(I-RS) if necessary + IF (PRESENT(m_f_vv_out)) THEN + CALL dbcsr_copy(m_f_vv_out, m_prec_out) + ENDIF + +#if 0 +!penalty_only=.TRUE. + WRITE (*, *) "prefactor0:", penalty_occ_vol_prefactor + !IF (penalty_occ_vol) THEN + CALL dbcsr_desymmetrize(m_s, & + m_prec_out) + !CALL dbcsr_scale(m_prec_out,-penalty_occ_vol_prefactor) + !ENDIF +#else + ! sum up the F_vv and S_vv terms + CALL dbcsr_add(m_prec_out, m_tmp_nn_1, & + 1.0_dp, 1.0_dp) + ! Scale to obtain unit step length + CALL dbcsr_scale(m_prec_out, 2.0_dp*spin_factor) + + ! add the contribution from the penalty on the occupied volume + IF (penalty_occ_vol) THEN + CALL dbcsr_add(m_prec_out, m_tmp_nn_1, & + 1.0_dp, penalty_occ_vol_prefactor) + ENDIF +#endif + + CALL dbcsr_copy(m_tmp_nn_1, m_prec_out) + + ! invert using various algorithms + IF (special_case .EQ. xalmo_case_block_diag) THEN ! non-overlapping diagonal blocks + + CALL pseudo_invert_diagonal_blk( & + matrix_in=m_tmp_nn_1, & + matrix_out=m_prec_out, & + nocc=nocc_of_domain(:) & + ) + + ELSE IF (special_case .EQ. xalmo_case_fully_deloc) THEN ! the entire system is a block + + ! invert using cholesky (works with S matrix, will not work with S-SRS matrix) + CALL cp_dbcsr_cholesky_decompose(m_prec_out, & + para_env=para_env, & + blacs_env=blacs_env) + CALL cp_dbcsr_cholesky_invert(m_prec_out, & + para_env=para_env, & + blacs_env=blacs_env, & + upper_to_full=.TRUE.) + CALL dbcsr_filter(m_prec_out, & + eps=eps_filter) + + ELSE + + !!! use a true domain preconditioner with overlapping domains + IF (assume_t0_q0x) THEN + precond_domain_projector = -1 + ELSE + precond_domain_projector = 0 + ENDIF + !! RZK-warning: use PRESENT to make two nearly-identical calls + !! this is done because intel compiler does not seem to conform + !! to the FORTRAN standard for passing through optional arguments + IF (PRESENT(bad_modes_projector_down_out)) THEN + CALL construct_domain_preconditioner( & + matrix_main=m_tmp_nn_1, & + subm_s_inv=domain_s_inv(:), & + subm_s_inv_half=domain_s_inv_half(:), & + subm_s_half=domain_s_half(:), & + subm_r_down=domain_r_down(:), & + matrix_trimmer=m_quench_t, & + dpattern=m_quench_t, & + map=domain_map, & + node_of_domain=cpu_of_domain, & + preconditioner=domain_prec_out(:), & + use_trimmer=.FALSE., & + bad_modes_projector_down=bad_modes_projector_down_out(:), & + eps_zero_eigenvalues=neg_thr, & + my_action=precond_domain_projector & + ) + ELSE + CALL construct_domain_preconditioner( & + matrix_main=m_tmp_nn_1, & + subm_s_inv=domain_s_inv(:), & + subm_r_down=domain_r_down(:), & + matrix_trimmer=m_quench_t, & + dpattern=m_quench_t, & + map=domain_map, & + node_of_domain=cpu_of_domain, & + preconditioner=domain_prec_out(:), & + use_trimmer=.FALSE., & + !eps_zero_eigenvalues=neg_thr,& + my_action=precond_domain_projector & + ) + ENDIF + ENDIF + + ! invert using cholesky (works with S matrix, will not work with S-SRS matrix) + !!!CALL cp_dbcsr_cholesky_decompose(prec_vv,& + !!! para_env=almo_scf_env%para_env,& + !!! blacs_env=almo_scf_env%blacs_env) + !!!CALL cp_dbcsr_cholesky_invert(prec_vv,& + !!! para_env=almo_scf_env%para_env,& + !!! blacs_env=almo_scf_env%blacs_env,& + !!! upper_to_full=.TRUE.) + !!!CALL dbcsr_filter(prec_vv,& + !!! eps=almo_scf_env%eps_filter) + !!! + + ! re-create the matrix because desymmetrize is buggy - + ! it will create multiple copies of blocks + !!!DESYM!CALL dbcsr_create(prec_vv,& + !!!DESYM! template=almo_scf_env%matrix_s(1),& + !!!DESYM! matrix_type=dbcsr_type_no_symmetry) + !!!DESYM!CALL dbcsr_desymmetrize(almo_scf_env%matrix_s(1),& + !!!DESYM! prec_vv) + !CALL dbcsr_multiply("N","N",1.0_dp,& + ! almo_scf_env%matrix_s(1),& + ! matrix_t_out(ispin),& + ! 0.0_dp,m_tmp_no_1,& + ! filter_eps=almo_scf_env%eps_filter) + !CALL dbcsr_multiply("N","N",1.0_dp,& + ! m_tmp_no_1,& + ! almo_scf_env%matrix_sigma_inv(ispin),& + ! 0.0_dp,m_tmp_no_3,& + ! filter_eps=almo_scf_env%eps_filter) + !CALL dbcsr_multiply("N","T",-1.0_dp,& + ! m_tmp_no_3,& + ! m_tmp_no_1,& + ! 1.0_dp,prec_vv,& + ! filter_eps=almo_scf_env%eps_filter) + !CALL dbcsr_add_on_diag(prec_vv,& + ! prec_sf_mixing_s) + + !CALL dbcsr_create(prec_oo,& + ! template=almo_scf_env%matrix_sigma(ispin),& + ! matrix_type=dbcsr_type_no_symmetry) + !CALL dbcsr_desymmetrize(almo_scf_env%matrix_sigma(ispin),& + ! matrix_type=dbcsr_type_no_symmetry) + !CALL dbcsr_desymmetrize(almo_scf_env%matrix_sigma(ispin),& + ! prec_oo) + !CALL dbcsr_filter(prec_oo,& + ! eps=almo_scf_env%eps_filter) + + !! invert using cholesky + !CALL dbcsr_create(prec_oo_inv,& + ! template=prec_oo,& + ! matrix_type=dbcsr_type_no_symmetry) + !CALL dbcsr_desymmetrize(prec_oo,& + ! prec_oo_inv) + !CALL cp_dbcsr_cholesky_decompose(prec_oo_inv,& + ! para_env=almo_scf_env%para_env,& + ! blacs_env=almo_scf_env%blacs_env) + !CALL cp_dbcsr_cholesky_invert(prec_oo_inv,& + ! para_env=almo_scf_env%para_env,& + ! blacs_env=almo_scf_env%blacs_env,& + ! upper_to_full=.TRUE.) + + CALL dbcsr_release(m_tmp_nn_1) + CALL dbcsr_release(m_tmp_no_3) + + CALL timestop(handle) + + END SUBROUTINE compute_preconditioner + +! ***************************************************************************** +!> \brief Compute beta for conjugate gradient algorithms +!> \param beta ... +!> \param numer ... +!> \param denom ... +!> \param reset_conjugator ... +!> \param conjugator ... +!> \param grad ... +!> \param prev_grad ... +!> \param step ... +!> \param prev_step ... +!> \param prev_minus_prec_grad ... +!> \par History +!> 2015.04 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE compute_cg_beta(beta, numer, denom, reset_conjugator, conjugator, & + grad, prev_grad, step, prev_step, prev_minus_prec_grad) + + REAL(KIND=dp), INTENT(INOUT) :: beta + REAL(KIND=dp), INTENT(INOUT), OPTIONAL :: numer, denom + LOGICAL, INTENT(INOUT) :: reset_conjugator + INTEGER, INTENT(IN) :: conjugator + TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: grad, prev_grad, step, prev_step + TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT), & + OPTIONAL :: prev_minus_prec_grad + + CHARACTER(len=*), PARAMETER :: routineN = 'compute_cg_beta', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, i, nsize, unit_nr + REAL(KIND=dp) :: den, kappa, my_denom, my_numer, & + my_numer2, my_numer3, num, num2, num3, & + tau + TYPE(cp_logger_type), POINTER :: logger + TYPE(dbcsr_type) :: m_tmp_no_1 + + CALL timeset(routineN, handle) + + ! get a useful output_unit + logger => cp_get_default_logger() + IF (logger%para_env%mepos == logger%para_env%source) THEN + unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.) + ELSE + unit_nr = -1 + ENDIF + + IF (.NOT. PRESENT(prev_minus_prec_grad)) THEN + IF (conjugator .EQ. cg_fletcher_reeves .OR. & + conjugator .EQ. cg_polak_ribiere .OR. & + conjugator .EQ. cg_hager_zhang) THEN + CPABORT("conjugator needs more input") + ENDIF + ENDIF + + ! return num denom so beta can be calculated spin-by-spin + IF (PRESENT(numer) .OR. PRESENT(denom)) THEN + IF (conjugator .EQ. cg_hestenes_stiefel .OR. & + conjugator .EQ. cg_dai_yuan .OR. & + conjugator .EQ. cg_hager_zhang) THEN + CPABORT("cannot return numer/denom") + ENDIF + ENDIF + + nsize = SIZE(grad) + + my_numer = 0.0_dp + my_numer2 = 0.0_dp + my_numer3 = 0.0_dp + my_denom = 0.0_dp + + DO i = 1, nsize + + CALL dbcsr_create(m_tmp_no_1, & + template=grad(i), & + matrix_type=dbcsr_type_no_symmetry) + + SELECT CASE (conjugator) + CASE (cg_hestenes_stiefel) + CALL dbcsr_copy(m_tmp_no_1, grad(i)) + CALL dbcsr_add(m_tmp_no_1, prev_grad(i), & + 1.0_dp, -1.0_dp) + CALL dbcsr_trace(m_tmp_no_1, step(i), num) + CALL dbcsr_trace(m_tmp_no_1, prev_step(i), den) + CASE (cg_fletcher_reeves) + CALL dbcsr_trace(grad(i), step(i), num) + CALL dbcsr_trace(prev_grad(i), prev_minus_prec_grad(i), den) + CASE (cg_polak_ribiere) + CALL dbcsr_trace(prev_grad(i), prev_minus_prec_grad(i), den) + CALL dbcsr_copy(m_tmp_no_1, grad(i)) + CALL dbcsr_add(m_tmp_no_1, prev_grad(i), 1.0_dp, -1.0_dp) + CALL dbcsr_trace(m_tmp_no_1, step(i), num) + CASE (cg_fletcher) + CALL dbcsr_trace(grad(i), step(i), num) + CALL dbcsr_trace(prev_grad(i), prev_step(i), den) + CASE (cg_liu_storey) + CALL dbcsr_trace(prev_grad(i), prev_step(i), den) + CALL dbcsr_copy(m_tmp_no_1, grad(i)) + CALL dbcsr_add(m_tmp_no_1, prev_grad(i), 1.0_dp, -1.0_dp) + CALL dbcsr_trace(m_tmp_no_1, step(i), num) + CASE (cg_dai_yuan) + CALL dbcsr_trace(grad(i), step(i), num) + CALL dbcsr_copy(m_tmp_no_1, grad(i)) + CALL dbcsr_add(m_tmp_no_1, prev_grad(i), 1.0_dp, -1.0_dp) + CALL dbcsr_trace(m_tmp_no_1, prev_step(i), den) + CASE (cg_hager_zhang) + CALL dbcsr_copy(m_tmp_no_1, grad(i)) + CALL dbcsr_add(m_tmp_no_1, prev_grad(i), 1.0_dp, -1.0_dp) + CALL dbcsr_trace(m_tmp_no_1, prev_step(i), den) + CALL dbcsr_trace(m_tmp_no_1, prev_minus_prec_grad(i), num) + CALL dbcsr_trace(m_tmp_no_1, step(i), num2) + CALL dbcsr_trace(prev_step(i), grad(i), num3) + my_numer2 = my_numer2+num2 + my_numer3 = my_numer3+num3 + CASE (cg_zero) + num = 0.0_dp + den = 1.0_dp + CASE DEFAULT + CPABORT("illegal conjugator") + END SELECT + my_numer = my_numer+num + my_denom = my_denom+den + + CALL dbcsr_release(m_tmp_no_1) + + ENDDO ! i - nsize + + DO i = 1, nsize + + SELECT CASE (conjugator) + CASE (cg_hestenes_stiefel, cg_dai_yuan) + beta = -1.0_dp*my_numer/my_denom + CASE (cg_fletcher_reeves, cg_polak_ribiere, cg_fletcher, cg_liu_storey) + beta = my_numer/my_denom + CASE (cg_hager_zhang) + kappa = -2.0_dp*my_numer/my_denom + tau = -1.0_dp*my_numer2/my_denom + beta = tau-kappa*my_numer3/my_denom + CASE (cg_zero) + beta = 0.0_dp + CASE DEFAULT + CPABORT("illegal conjugator") + END SELECT + + ENDDO ! i - nsize + + IF (beta .LT. 0.0_dp) THEN + IF (unit_nr > 0) THEN + WRITE (unit_nr, *) " Resetting conjugator because beta is negative: ", beta + ENDIF + reset_conjugator = .TRUE. + ENDIF + + IF (PRESENT(numer)) THEN + numer = my_numer + ENDIF + IF (PRESENT(denom)) THEN + denom = my_denom + ENDIF + + CALL timestop(handle) + + END SUBROUTINE compute_cg_beta + +! ***************************************************************************** +!> \brief computes the step matrix from the gradient and Hessian using +!> the Newton-Raphson method +!> \param optimizer ... +!> \param m_grad ... +!> \param m_delta ... +!> \param m_s ... +!> \param m_ks ... +!> \param m_siginv ... +!> \param m_quench_t ... +!> \param m_FTsiginv ... +!> \param m_siginvTFTsiginv ... +!> \param m_ST ... +!> \param m_t ... +!> \param m_sig_sqrti_ii ... +!> \param domain_s_inv ... +!> \param domain_r_down ... +!> \param domain_map ... +!> \param cpu_of_domain ... +!> \param nocc_of_domain ... +!> \param para_env ... +!> \param blacs_env ... +!> \param eps_filter ... +!> \param optimize_theta ... +!> \param penalty_occ_vol ... +!> \param normalize_orbitals ... +!> \param penalty_occ_vol_prefactor ... +!> \param penalty_occ_vol_pf2 ... +!> \param special_case ... +!> \par History +!> 2015.04 created [Rustam Z. Khaliullin] +!> \author Rustam Z. Khaliullin +! ************************************************************************************************** + SUBROUTINE newton_grad_to_step(optimizer, m_grad, m_delta, m_s, m_ks, & + m_siginv, m_quench_t, m_FTsiginv, m_siginvTFTsiginv, m_ST, m_t, & + m_sig_sqrti_ii, domain_s_inv, domain_r_down, domain_map, cpu_of_domain, & + nocc_of_domain, para_env, blacs_env, eps_filter, optimize_theta, & + penalty_occ_vol, normalize_orbitals, penalty_occ_vol_prefactor, & + penalty_occ_vol_pf2, special_case) + + TYPE(optimizer_options_type) :: optimizer + TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_grad + TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_delta, m_s, m_ks, m_siginv, m_quench_t + TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_FTsiginv, m_siginvTFTsiginv, m_ST, & + m_t, m_sig_sqrti_ii + TYPE(domain_submatrix_type), DIMENSION(:, :), & + INTENT(IN) :: domain_s_inv, domain_r_down + TYPE(domain_map_type), DIMENSION(:), INTENT(IN) :: domain_map + INTEGER, DIMENSION(:), INTENT(IN) :: cpu_of_domain + INTEGER, DIMENSION(:, :), INTENT(IN) :: nocc_of_domain + TYPE(cp_para_env_type), POINTER :: para_env + TYPE(cp_blacs_env_type), POINTER :: blacs_env + REAL(KIND=dp), INTENT(IN) :: eps_filter + LOGICAL, INTENT(IN) :: optimize_theta, penalty_occ_vol, & + normalize_orbitals + REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: penalty_occ_vol_prefactor, & + penalty_occ_vol_pf2 + INTEGER, INTENT(IN) :: special_case + + CHARACTER(len=*), PARAMETER :: routineN = 'newton_grad_to_step', & + routineP = moduleN//':'//routineN + + CHARACTER(LEN=20) :: iter_type + INTEGER :: handle, ispin, iteration, max_iter, & + ndomains, nspins, outer_iteration, & + outer_max_iter, unit_nr + LOGICAL :: converged, do_exact_inversion, outer_prepare_to_exit, prepare_to_exit, & + reset_conjugator, use_preconditioner + REAL(KIND=dp) :: alpha, beta, denom, denom_ispin, & + eps_error_target, numer, numer_ispin, & + residue_norm, spin_factor, t1, t2 + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: residue_max_norm + TYPE(cp_logger_type), POINTER :: logger + TYPE(dbcsr_type) :: m_tmp_oo_1, m_tmp_oo_2 + TYPE(dbcsr_type), ALLOCATABLE, DIMENSION(:) :: m_f_vo, m_f_vv, m_Hstep, m_prec, & + m_residue, m_residue_prev, m_s_vv, & + m_step, m_STsiginv, m_zet, m_zet_prev + TYPE(domain_submatrix_type), ALLOCATABLE, & + DIMENSION(:, :) :: domain_prec + + CALL timeset(routineN, handle) + + ! get a useful output_unit + logger => cp_get_default_logger() + IF (logger%para_env%mepos == logger%para_env%source) THEN + unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.) + ELSE + unit_nr = -1 + ENDIF + + !!! Currently for non-theta only + IF (optimize_theta) THEN + CPABORT("theta is NYI") + ENDIF + + ! set optimizer options + use_preconditioner = (optimizer%preconditioner .NE. xalmo_prec_zero) + outer_max_iter = optimizer%max_iter_outer_loop + max_iter = optimizer%max_iter + eps_error_target = optimizer%eps_error + + ! set key dimensions + nspins = SIZE(m_ks) + ndomains = SIZE(domain_s_inv, 1) + + IF (nspins == 1) THEN + spin_factor = 2.0_dp + ELSE + spin_factor = 1.0_dp + ENDIF + + ALLOCATE (domain_prec(ndomains, nspins)) + CALL init_submatrices(domain_prec) + + ! allocate matrices + ALLOCATE (m_residue(nspins)) + ALLOCATE (m_residue_prev(nspins)) + ALLOCATE (m_step(nspins)) + ALLOCATE (m_zet(nspins)) + ALLOCATE (m_zet_prev(nspins)) + ALLOCATE (m_Hstep(nspins)) + ALLOCATE (m_prec(nspins)) + ALLOCATE (m_s_vv(nspins)) + ALLOCATE (m_f_vv(nspins)) + ALLOCATE (m_f_vo(nspins)) + ALLOCATE (m_STsiginv(nspins)) + + ALLOCATE (residue_max_norm(nspins)) + + ! initiate objects before iterations + DO ispin = 1, nspins + + ! init matrices + CALL dbcsr_create(m_residue(ispin), & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_residue_prev(ispin), & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_step(ispin), & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_zet_prev(ispin), & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_zet(ispin), & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_Hstep(ispin), & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_f_vo(ispin), & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_STsiginv(ispin), & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_f_vv(ispin), & + template=m_ks(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_s_vv(ispin), & + template=m_s(1), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_prec(ispin), & + template=m_ks(ispin), & + matrix_type=dbcsr_type_no_symmetry) + + ! compute the full "gradient" - it is necessary to + ! evaluate Hessian.X + CALL dbcsr_copy(m_f_vo(ispin), m_FTsiginv(ispin)) + CALL dbcsr_multiply("N", "N", -1.0_dp, & + m_ST(ispin), & + m_siginvTFTsiginv(ispin), & + 1.0_dp, m_f_vo(ispin), & + filter_eps=eps_filter) + +! RZK-warning +! compute preconditioner even if we do not use it +! this is for debugging because compute_preconditioner includes +! computing F_vv and S_vv necessary for +! IF ( use_preconditioner ) THEN + +! domain_s_inv and domain_r_down are never used with assume_t0_q0x=FALSE + CALL compute_preconditioner( & + domain_prec_out=domain_prec(:, ispin), & + m_prec_out=m_prec(ispin), & + m_ks=m_ks(ispin), & + m_s=m_s(1), & + m_siginv=m_siginv(ispin), & + m_quench_t=m_quench_t(ispin), & + m_FTsiginv=m_FTsiginv(ispin), & + m_siginvTFTsiginv=m_siginvTFTsiginv(ispin), & + m_ST=m_ST(ispin), & + m_STsiginv_out=m_STsiginv(ispin), & + m_s_vv_out=m_s_vv(ispin), & + m_f_vv_out=m_f_vv(ispin), & + para_env=para_env, & + blacs_env=blacs_env, & + nocc_of_domain=nocc_of_domain(:, ispin), & + domain_s_inv=domain_s_inv(:, ispin), & + domain_r_down=domain_r_down(:, ispin), & + cpu_of_domain=cpu_of_domain(:), & + domain_map=domain_map(ispin), & + assume_t0_q0x=.FALSE., & + penalty_occ_vol=penalty_occ_vol, & + penalty_occ_vol_prefactor=penalty_occ_vol_prefactor(ispin), & + eps_filter=eps_filter, & + neg_thr=0.5_dp, & + spin_factor=spin_factor, & + special_case=special_case & + ) + +! ENDIF ! use_preconditioner + + ! initial guess + CALL dbcsr_copy(m_delta(ispin), m_quench_t(ispin)) + ! in order to use dbcsr_set matrix blocks must exist + CALL dbcsr_set(m_delta(ispin), 0.0_dp) + CALL dbcsr_copy(m_residue(ispin), m_grad(ispin)) + CALL dbcsr_scale(m_residue(ispin), -1.0_dp) + + do_exact_inversion = .FALSE. + IF (do_exact_inversion) THEN + + ! copy grad to m_step temporarily + ! use m_step as input to the inversion routine + CALL dbcsr_copy(m_step(ispin), m_grad(ispin)) + + ! expensive "exact" inversion of the "nearly-exact" Hessian + ! hopefully returns Z=-H^(-1).G + CALL hessian_diag_apply( & + matrix_grad=m_step(ispin), & + matrix_step=m_zet(ispin), & + matrix_S_ao=m_s_vv(ispin), & + matrix_F_ao=m_f_vv(ispin), & + !matrix_S_ao=m_s(ispin),& + !matrix_F_ao=m_ks(ispin),& + matrix_S_mo=m_siginv(ispin), & + matrix_F_mo=m_siginvTFTsiginv(ispin), & + matrix_S_vo=m_STsiginv(ispin), & + matrix_F_vo=m_f_vo(ispin), & + quench_t=m_quench_t(ispin), & + spin_factor=spin_factor, & + eps_zero=eps_filter*10.0_dp, & + penalty_occ_vol=penalty_occ_vol, & + penalty_occ_vol_prefactor=penalty_occ_vol_prefactor(ispin), & + penalty_occ_vol_pf2=penalty_occ_vol_pf2(ispin), & + m_s=m_s(1), & + para_env=para_env, & + blacs_env=blacs_env & + ) + ! correct solution by the spin factor + !CALL dbcsr_scale(m_zet(ispin),1.0_dp/(2.0_dp*spin_factor)) + + ELSE ! use PCG to solve H.D=-G + + IF (use_preconditioner) THEN + + IF (special_case .EQ. xalmo_case_block_diag .OR. & + special_case .EQ. xalmo_case_fully_deloc) THEN + + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_prec(ispin), & + m_residue(ispin), & + 0.0_dp, m_zet(ispin), & + filter_eps=eps_filter) + + ELSE + + CALL apply_domain_operators( & + matrix_in=m_residue(ispin), & + matrix_out=m_zet(ispin), & + operator1=domain_prec(:, ispin), & + dpattern=m_quench_t(ispin), & + map=domain_map(ispin), & + node_of_domain=cpu_of_domain(:), & + my_action=0, & + filter_eps=eps_filter & + !matrix_trimmer=,& + !use_trimmer=.FALSE.,& + ) + + ENDIF ! special_case + + ELSE ! do not use preconditioner + + CALL dbcsr_copy(m_zet(ispin), m_residue(ispin)) + + ENDIF ! use_preconditioner + + ENDIF ! do_exact_inversion + + CALL dbcsr_copy(m_step(ispin), m_zet(ispin)) + + ENDDO !ispin + + ! start the outer SCF loop + outer_prepare_to_exit = .FALSE. + outer_iteration = 0 + residue_norm = 0.0_dp + + DO + + ! start the inner SCF loop + prepare_to_exit = .FALSE. + converged = .FALSE. + iteration = 0 + t1 = m_walltime() + + DO + + ! apply hessian to the step matrix + CALL apply_hessian( & + m_x_in=m_step, & + m_x_out=m_Hstep, & + m_ks=m_ks, & + m_s=m_s, & + m_siginv=m_siginv, & + m_quench_t=m_quench_t, & + m_FTsiginv=m_FTsiginv, & + m_siginvTFTsiginv=m_siginvTFTsiginv, & + m_ST=m_ST, & + m_STsiginv=m_STsiginv, & + m_s_vv=m_s_vv, & + m_ks_vv=m_f_vv, & + !m_s_vv=m_s,& + !m_ks_vv=m_ks,& + m_g_full=m_f_vo, & + m_t=m_t, & + m_sig_sqrti_ii=m_sig_sqrti_ii, & + penalty_occ_vol=penalty_occ_vol, & + normalize_orbitals=normalize_orbitals, & + penalty_occ_vol_prefactor=penalty_occ_vol_prefactor, & + eps_filter=eps_filter, & + path_num=hessian_path_reuse & + ) + + ! alpha is computed outside the spin loop + numer = 0.0_dp + denom = 0.0_dp + DO ispin = 1, nspins + + CALL dbcsr_trace(m_residue(ispin), m_zet(ispin), numer_ispin) + CALL dbcsr_trace(m_step(ispin), m_Hstep(ispin), denom_ispin) + + numer = numer+numer_ispin + denom = denom+denom_ispin + + ENDDO !ispin + + alpha = numer/denom + + DO ispin = 1, nspins + + ! update the variable + CALL dbcsr_add(m_delta(ispin), m_step(ispin), 1.0_dp, alpha) + CALL dbcsr_copy(m_residue_prev(ispin), m_residue(ispin)) + CALL dbcsr_add(m_residue(ispin), m_Hstep(ispin), & + 1.0_dp, -1.0_dp*alpha) + CALL dbcsr_norm(m_residue(ispin), dbcsr_norm_maxabsnorm, & + norm_scalar=residue_max_norm(ispin)) + + ENDDO ! ispin + + ! check convergence and other exit criteria + residue_norm = MAXVAL(residue_max_norm) + converged = (residue_norm .LT. eps_error_target) + IF (converged .OR. (iteration .GE. max_iter)) THEN + prepare_to_exit = .TRUE. + ENDIF + + IF (.NOT. prepare_to_exit) THEN + + DO ispin = 1, nspins + + ! save current z before the update + CALL dbcsr_copy(m_zet_prev(ispin), m_zet(ispin)) + + ! compute the new step (apply preconditioner if available) + IF (use_preconditioner) THEN + + !IF (unit_nr>0) THEN + ! WRITE(unit_nr,*) "....applying preconditioner...." + !ENDIF + + IF (special_case .EQ. xalmo_case_block_diag .OR. & + special_case .EQ. xalmo_case_fully_deloc) THEN + + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_prec(ispin), & + m_residue(ispin), & + 0.0_dp, m_zet(ispin), & + filter_eps=eps_filter) + + ELSE + + CALL apply_domain_operators( & + matrix_in=m_residue(ispin), & + matrix_out=m_zet(ispin), & + operator1=domain_prec(:, ispin), & + dpattern=m_quench_t(ispin), & + map=domain_map(ispin), & + node_of_domain=cpu_of_domain(:), & + my_action=0, & + filter_eps=eps_filter & + !matrix_trimmer=,& + !use_trimmer=.FALSE.,& + ) + + ENDIF ! special case + + ELSE + + CALL dbcsr_copy(m_zet(ispin), m_residue(ispin)) + + ENDIF + + ENDDO !ispin + + ! compute the conjugation coefficient - beta + CALL compute_cg_beta( & + beta=beta, & + reset_conjugator=reset_conjugator, & + conjugator=cg_fletcher, & + grad=m_residue, & + prev_grad=m_residue_prev, & + step=m_zet, & + prev_step=m_zet_prev) + + DO ispin = 1, nspins + + ! conjugate the step direction + CALL dbcsr_add(m_step(ispin), m_zet(ispin), beta, 1.0_dp) + + ENDDO !ispin + + ENDIF ! not.prepare_to_exit + + t2 = m_walltime() + IF (unit_nr > 0) THEN + !iter_type=TRIM("ALMO SCF "//iter_type) + iter_type = TRIM("NR STEP") + WRITE (unit_nr, '(T6,A9,I6,F14.5,F14.5,F15.10,F9.2)') & + iter_type, iteration, & + alpha, beta, residue_norm, & + t2-t1 + ENDIF + t1 = m_walltime() + + iteration = iteration+1 + IF (prepare_to_exit) EXIT + + ENDDO ! inner loop + + IF (converged .OR. (outer_iteration .GE. outer_max_iter)) THEN + outer_prepare_to_exit = .TRUE. + ENDIF + + outer_iteration = outer_iteration+1 + IF (outer_prepare_to_exit) EXIT + + ENDDO ! outer loop + +! is not necessary if penalty_occ_vol_pf2=0.0 +#if 0 + + IF (penalty_occ_vol) THEN + + DO ispin = 1, nspins + + CALL dbcsr_copy(m_zet(ispin), m_grad(ispin)) + CALL dbcsr_trace(m_delta(ispin), m_zet(ispin), alpha) + WRITE (*, *) "trace(grad.delta): ", alpha + alpha = -1.0_dp/(penalty_occ_vol_pf2(ispin)*alpha-1.0_dp) + WRITE (*, *) "correction alpha: ", alpha + CALL dbcsr_scale(m_delta(ispin), alpha) + + ENDDO + + ENDIF + +#endif + + DO ispin = 1, nspins + + ! check whether the step lies entirely in R or Q + CALL dbcsr_create(m_tmp_oo_1, & + template=m_siginv(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_tmp_oo_2, & + template=m_siginv(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_multiply("T", "N", 1.0_dp, & + m_ST(ispin), & + m_delta(ispin), & + 0.0_dp, m_tmp_oo_1, & + filter_eps=eps_filter) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_siginv(ispin), & + m_tmp_oo_1, & + 0.0_dp, m_tmp_oo_2, & + filter_eps=eps_filter) + CALL dbcsr_copy(m_zet(ispin), m_quench_t(ispin)) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_t(ispin), & + m_tmp_oo_2, & + 0.0_dp, m_zet(ispin), & + retain_sparsity=.TRUE.) + CALL dbcsr_norm(m_zet(ispin), dbcsr_norm_maxabsnorm, & + norm_scalar=alpha) + WRITE (*, "(A50,2F20.10)") "Occupied-space projection of the step", alpha + CALL dbcsr_add(m_zet(ispin), m_delta(ispin), -1.0_dp, 1.0_dp) + CALL dbcsr_norm(m_zet(ispin), dbcsr_norm_maxabsnorm, & + norm_scalar=alpha) + WRITE (*, "(A50,2F20.10)") "Virtual-space projection of the step", alpha + CALL dbcsr_norm(m_delta(ispin), dbcsr_norm_maxabsnorm, & + norm_scalar=alpha) + WRITE (*, "(A50,2F20.10)") "Full step", alpha + CALL dbcsr_release(m_tmp_oo_1) + CALL dbcsr_release(m_tmp_oo_2) + + ENDDO + + ! clean up + DO ispin = 1, nspins + CALL release_submatrices(domain_prec(:, ispin)) + CALL dbcsr_release(m_residue(ispin)) + CALL dbcsr_release(m_residue_prev(ispin)) + CALL dbcsr_release(m_step(ispin)) + CALL dbcsr_release(m_zet(ispin)) + CALL dbcsr_release(m_zet_prev(ispin)) + CALL dbcsr_release(m_Hstep(ispin)) + CALL dbcsr_release(m_f_vo(ispin)) + CALL dbcsr_release(m_f_vv(ispin)) + CALL dbcsr_release(m_s_vv(ispin)) + CALL dbcsr_release(m_prec(ispin)) + CALL dbcsr_release(m_STsiginv(ispin)) + ENDDO !ispin + DEALLOCATE (domain_prec) + DEALLOCATE (m_residue) + DEALLOCATE (m_residue_prev) + DEALLOCATE (m_step) + DEALLOCATE (m_zet) + DEALLOCATE (m_zet_prev) + DEALLOCATE (m_prec) + DEALLOCATE (m_Hstep) + DEALLOCATE (m_s_vv) + DEALLOCATE (m_f_vv) + DEALLOCATE (m_f_vo) + DEALLOCATE (m_STsiginv) + DEALLOCATE (residue_max_norm) + + IF (.NOT. converged) THEN + CPABORT("Optimization not converged!") + ENDIF + + ! check that the step satisfies H.step=-grad + + CALL timestop(handle) + + END SUBROUTINE newton_grad_to_step + +! ***************************************************************************** +!> \brief Computes Hessian.X +!> \param m_x_in ... +!> \param m_x_out ... +!> \param m_ks ... +!> \param m_s ... +!> \param m_siginv ... +!> \param m_quench_t ... +!> \param m_FTsiginv ... +!> \param m_siginvTFTsiginv ... +!> \param m_ST ... +!> \param m_STsiginv ... +!> \param m_s_vv ... +!> \param m_ks_vv ... +!> \param m_g_full ... +!> \param m_t ... +!> \param m_sig_sqrti_ii ... +!> \param penalty_occ_vol ... +!> \param normalize_orbitals ... +!> \param penalty_occ_vol_prefactor ... +!> \param eps_filter ... +!> \param path_num ... +!> \par History +!> 2015.04 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE apply_hessian(m_x_in, m_x_out, m_ks, m_s, m_siginv, & + m_quench_t, m_FTsiginv, m_siginvTFTsiginv, m_ST, m_STsiginv, m_s_vv, & + m_ks_vv, m_g_full, m_t, m_sig_sqrti_ii, penalty_occ_vol, & + normalize_orbitals, penalty_occ_vol_prefactor, eps_filter, path_num) + + TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_x_in, m_x_out, m_ks, m_s + TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_siginv + TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_quench_t + TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_FTsiginv, m_siginvTFTsiginv, m_ST, & + m_STsiginv + TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT) :: m_s_vv, m_ks_vv, m_g_full + TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: m_t, m_sig_sqrti_ii + LOGICAL, INTENT(IN) :: penalty_occ_vol, normalize_orbitals + REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: penalty_occ_vol_prefactor + REAL(KIND=dp), INTENT(IN) :: eps_filter + INTEGER, INTENT(IN) :: path_num + + CHARACTER(len=*), PARAMETER :: routineN = 'apply_hessian', routineP = moduleN//':'//routineN + + INTEGER :: dim0, handle, ispin, nspins + REAL(KIND=dp) :: penalty_prefactor_local, spin_factor + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: tg_diagonal + TYPE(dbcsr_type) :: m_tmp_no_1, m_tmp_no_2, m_tmp_oo_1, & + m_tmp_x_in + + CALL timeset(routineN, handle) + + !JHU: test and use for unused debug variables + IF (penalty_occ_vol) penalty_prefactor_local = 1._dp + CPASSERT(SIZE(m_STsiginv) >= 0) + CPASSERT(SIZE(m_siginvTFTsiginv) >= 0) + CPASSERT(SIZE(m_s) >= 0) + CPASSERT(SIZE(m_g_full) >= 0) + CPASSERT(SIZE(m_FTsiginv) >= 0) + + nspins = SIZE(m_ks) + + IF (nspins .EQ. 1) THEN + spin_factor = 2.0_dp + ELSE + spin_factor = 1.0_dp + ENDIF + + DO ispin = 1, nspins + + penalty_prefactor_local = penalty_occ_vol_prefactor(ispin)/(2.0_dp*spin_factor) + + CALL dbcsr_create(m_tmp_oo_1, & + template=m_siginv(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_tmp_no_1, & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_tmp_no_2, & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(m_tmp_x_in, & + template=m_quench_t(ispin), & + matrix_type=dbcsr_type_no_symmetry) + + ! transform the input X to take into account the normalization constraint + IF (normalize_orbitals) THEN + + ! H.D = ( (H.D) - ST.[tr(T).(H.D)]_ii ) . [sig_sqrti]_ii + + ! get [tr(T).HD]_ii + CALL dbcsr_copy(m_tmp_oo_1, m_sig_sqrti_ii(ispin)) + CALL dbcsr_multiply("T", "N", 1.0_dp, & + m_x_in(ispin), & + m_ST(ispin), & + 0.0_dp, m_tmp_oo_1, & + retain_sparsity=.TRUE.) + CALL dbcsr_get_info(m_sig_sqrti_ii(ispin), nfullrows_total=dim0) + ALLOCATE (tg_diagonal(dim0)) + CALL dbcsr_get_diag(m_tmp_oo_1, tg_diagonal) + CALL dbcsr_set(m_tmp_oo_1, 0.0_dp) + CALL dbcsr_set_diag(m_tmp_oo_1, tg_diagonal) + DEALLOCATE (tg_diagonal) + + CALL dbcsr_copy(m_tmp_no_1, m_x_in(ispin)) + CALL dbcsr_multiply("N", "N", -1.0_dp, & + m_t(ispin), & + m_tmp_oo_1, & + 1.0_dp, m_tmp_no_1, & + filter_eps=eps_filter) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_tmp_no_1, & + m_sig_sqrti_ii(ispin), & + 0.0_dp, m_tmp_x_in, & + filter_eps=eps_filter) + + ELSE + + CALL dbcsr_copy(m_tmp_x_in, m_x_in(ispin)) + + ENDIF ! normalize_orbitals + + IF (path_num .EQ. hessian_path_reuse) THEN + + ! apply pre-computed F_vv and S_vv to X + +#if 0 +! RZK-warning: negative sign at penalty_prefactor_local is that +! magical fix for the negative definite problem +! (since penalty_prefactor_local<0 the coeff before S_vv must +! be multiplied by -1 to take the step in the right direction) +!CALL dbcsr_multiply("N","N",-4.0_dp*penalty_prefactor_local,& +! m_s_vv(ispin),& +! m_tmp_x_in,& +! 0.0_dp,m_tmp_no_1,& +! filter_eps=eps_filter) +!CALL dbcsr_copy(m_x_out(ispin),m_quench_t(ispin)) +!CALL dbcsr_multiply("N","N",1.0_dp,& +! m_tmp_no_1,& +! m_siginv(ispin),& +! 0.0_dp,m_x_out(ispin),& +! retain_sparsity=.TRUE.) + + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_s(1), & + m_tmp_x_in, & + 0.0_dp, m_tmp_no_1, & + filter_eps=eps_filter) + CALL dbcsr_copy(m_x_out(ispin), m_quench_t(ispin)) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_tmp_no_1, & + m_siginv(ispin), & + 0.0_dp, m_x_out(ispin), & + retain_sparsity=.TRUE.) + +!CALL dbcsr_copy(m_x_out(ispin),m_quench_t(ispin)) +!CALL dbcsr_multiply("N","N",1.0_dp,& +! m_s(1),& +! m_tmp_x_in,& +! 0.0_dp,m_x_out(ispin),& +! retain_sparsity=.TRUE.) + +#else + + ! debugging: only vv matrices, oo matrices are kronecker + CALL dbcsr_copy(m_x_out(ispin), m_quench_t(ispin)) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_ks_vv(ispin), & + m_tmp_x_in, & + 0.0_dp, m_x_out(ispin), & + retain_sparsity=.TRUE.) + + CALL dbcsr_copy(m_tmp_no_2, m_quench_t(ispin)) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_s_vv(ispin), & + m_tmp_x_in, & + 0.0_dp, m_tmp_no_2, & + retain_sparsity=.TRUE.) + CALL dbcsr_add(m_x_out(ispin), m_tmp_no_2, & + 1.0_dp, -4.0_dp*penalty_prefactor_local+1.0_dp) +#endif + +! ! F_vv.X.S_oo +! CALL dbcsr_multiply("N","N",1.0_dp,& +! m_ks_vv(ispin),& +! m_tmp_x_in,& +! 0.0_dp,m_tmp_no_1,& +! filter_eps=eps_filter,& +! ) +! CALL dbcsr_copy(m_x_out(ispin),m_quench_t(ispin)) +! CALL dbcsr_multiply("N","N",1.0_dp,& +! m_tmp_no_1,& +! m_siginv(ispin),& +! 0.0_dp,m_x_out(ispin),& +! retain_sparsity=.TRUE.,& +! ) +! +! ! S_vv.X.F_oo +! CALL dbcsr_multiply("N","N",1.0_dp,& +! m_s_vv(ispin),& +! m_tmp_x_in,& +! 0.0_dp,m_tmp_no_1,& +! filter_eps=eps_filter,& +! ) +! CALL dbcsr_copy(m_tmp_no_2,m_quench_t(ispin)) +! CALL dbcsr_multiply("N","N",1.0_dp,& +! m_tmp_no_1,& +! m_siginvTFTsiginv(ispin),& +! 0.0_dp,m_tmp_no_2,& +! retain_sparsity=.TRUE.,& +! ) +! CALL dbcsr_add(m_x_out(ispin),m_tmp_no_2,& +! 1.0_dp,-1.0_dp) +!! we have to add occ voll penalty here (the Svv termi (i.e. both Svv.D.Soo) +!! and STsiginv terms) +! +! ! S_vo.X^t.F_vo +! CALL dbcsr_multiply("T","N",1.0_dp,& +! m_tmp_x_in,& +! m_g_full(ispin),& +! 0.0_dp,m_tmp_oo_1,& +! filter_eps=eps_filter,& +! ) +! CALL dbcsr_copy(m_tmp_no_2,m_quench_t(ispin)) +! CALL dbcsr_multiply("N","N",1.0_dp,& +! m_STsiginv(ispin),& +! m_tmp_oo_1,& +! 0.0_dp,m_tmp_no_2,& +! retain_sparsity=.TRUE.,& +! ) +! CALL dbcsr_add(m_x_out(ispin),m_tmp_no_2,& +! 1.0_dp,-1.0_dp) +! +! ! S_vo.X^t.F_vo +! CALL dbcsr_multiply("T","N",1.0_dp,& +! m_tmp_x_in,& +! m_STsiginv(ispin),& +! 0.0_dp,m_tmp_oo_1,& +! filter_eps=eps_filter,& +! ) +! CALL dbcsr_copy(m_tmp_no_2,m_quench_t(ispin)) +! CALL dbcsr_multiply("N","N",1.0_dp,& +! m_g_full(ispin),& +! m_tmp_oo_1,& +! 0.0_dp,m_tmp_no_2,& +! retain_sparsity=.TRUE.,& +! ) +! CALL dbcsr_add(m_x_out(ispin),m_tmp_no_2,& +! 1.0_dp,-1.0_dp) + + ELSE IF (path_num .EQ. hessian_path_assemble) THEN + + ! compute F_vv.X and S_vv.X directly + ! this path will be advantageous if the number + ! of PCG iterations is small + CPABORT("path is NYI") + + ELSE + CPABORT("illegal path") + ENDIF ! path + + ! transform the output to take into account the normalization constraint + IF (normalize_orbitals) THEN + + ! H.D = ( (H.D) - ST.[tr(T).(H.D)]_ii ) . [sig_sqrti]_ii + + ! get [tr(T).HD]_ii + CALL dbcsr_copy(m_tmp_oo_1, m_sig_sqrti_ii(ispin)) + CALL dbcsr_multiply("T", "N", 1.0_dp, & + m_t(ispin), & + m_x_out(ispin), & + 0.0_dp, m_tmp_oo_1, & + retain_sparsity=.TRUE.) + CALL dbcsr_get_info(m_sig_sqrti_ii(ispin), nfullrows_total=dim0) + ALLOCATE (tg_diagonal(dim0)) + CALL dbcsr_get_diag(m_tmp_oo_1, tg_diagonal) + CALL dbcsr_set(m_tmp_oo_1, 0.0_dp) + CALL dbcsr_set_diag(m_tmp_oo_1, tg_diagonal) + DEALLOCATE (tg_diagonal) + + CALL dbcsr_multiply("N", "N", -1.0_dp, & + m_ST(ispin), & + m_tmp_oo_1, & + 1.0_dp, m_x_out(ispin), & + retain_sparsity=.TRUE.) + CALL dbcsr_copy(m_tmp_no_1, m_x_out(ispin)) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + m_tmp_no_1, & + m_sig_sqrti_ii(ispin), & + 0.0_dp, m_x_out(ispin), & + retain_sparsity=.TRUE.) + + ENDIF ! normalize_orbitals + + CALL dbcsr_scale(m_x_out(ispin), & + 2.0_dp*spin_factor) + + CALL dbcsr_release(m_tmp_oo_1) + CALL dbcsr_release(m_tmp_no_1) + CALL dbcsr_release(m_tmp_no_2) + CALL dbcsr_release(m_tmp_x_in) + + ENDDO !ispin + + ! there is one more part of the hessian that comes + ! from T-dependence of the KS matrix + ! it is neglected here + + CALL timestop(handle) + + END SUBROUTINE apply_hessian + +! ***************************************************************************** +!> \brief Serial code that constructs an approximate Hessian +!> \param matrix_grad ... +!> \param matrix_step ... +!> \param matrix_S_ao ... +!> \param matrix_F_ao ... +!> \param matrix_S_mo ... +!> \param matrix_F_mo ... +!> \param matrix_S_vo ... +!> \param matrix_F_vo ... +!> \param quench_t ... +!> \param penalty_occ_vol ... +!> \param penalty_occ_vol_prefactor ... +!> \param penalty_occ_vol_pf2 ... +!> \param spin_factor ... +!> \param eps_zero ... +!> \param m_s ... +!> \param para_env ... +!> \param blacs_env ... +!> \par History +!> 2012.02 created [Rustam Z. Khaliullin] +!> \author Rustam Z. Khaliullin +! ************************************************************************************************** + SUBROUTINE hessian_diag_apply(matrix_grad, matrix_step, matrix_S_ao, & + matrix_F_ao, matrix_S_mo, matrix_F_mo, matrix_S_vo, matrix_F_vo, quench_t, & + penalty_occ_vol, penalty_occ_vol_prefactor, penalty_occ_vol_pf2, & + spin_factor, eps_zero, m_s, para_env, blacs_env) + + TYPE(dbcsr_type), INTENT(INOUT) :: matrix_grad, matrix_step, matrix_S_ao, & + matrix_F_ao, matrix_S_mo + TYPE(dbcsr_type), INTENT(IN) :: matrix_F_mo + TYPE(dbcsr_type), INTENT(INOUT) :: matrix_S_vo, matrix_F_vo, quench_t + LOGICAL, INTENT(IN) :: penalty_occ_vol + REAL(KIND=dp), INTENT(IN) :: penalty_occ_vol_prefactor, & + penalty_occ_vol_pf2, spin_factor, & + eps_zero + TYPE(dbcsr_type), INTENT(IN) :: m_s + TYPE(cp_para_env_type), POINTER :: para_env + TYPE(cp_blacs_env_type), POINTER :: blacs_env + + CHARACTER(len=*), PARAMETER :: routineN = 'hessian_diag_apply', & + routineP = moduleN//':'//routineN + + INTEGER :: ao_hori_offset, ao_vert_offset, block_col, block_row, col, H_size, handle, ii, & + INFO, jj, lev1_hori_offset, lev1_vert_offset, lev2_hori_offset, lev2_vert_offset, LWORK, & + nblkcols_tot, nblkrows_tot, ncores, orb_i, orb_j, row, zero_neg_eiv + INTEGER, ALLOCATABLE, DIMENSION(:) :: ao_block_sizes, ao_domain_sizes, & + mo_block_sizes + INTEGER, DIMENSION(:), POINTER :: ao_blk_sizes, mo_blk_sizes + LOGICAL :: found, found_col, found_row + REAL(KIND=dp) :: penalty_prefactor_local, test_error + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: eigenvalues, Grad_vec, Step_vec, tmp, & + tmpr, work + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: F_ao_block, F_mo_block, H, Hinv, & + S_ao_block, S_mo_block, test, test2 + REAL(KIND=dp), DIMENSION(:, :), POINTER :: block_p, p_new_block + TYPE(dbcsr_distribution_type) :: main_dist + TYPE(dbcsr_type) :: matrix_F_ao_sym, matrix_F_mo_sym, & + matrix_S_ao_sym, matrix_S_mo_sym + + CALL timeset(routineN, handle) + + !JHU use and test for unused debug variables + CPASSERT(ASSOCIATED(blacs_env)) + CPASSERT(ASSOCIATED(para_env)) + CALL dbcsr_get_info(m_s, row_blk_size=ao_blk_sizes) + CALL dbcsr_get_info(matrix_S_vo, row_blk_size=ao_blk_sizes) + CALL dbcsr_get_info(matrix_F_vo, row_blk_size=ao_blk_sizes) + + ! serial code only + CALL dbcsr_get_info(matrix=matrix_S_ao, distribution=main_dist) + CALL dbcsr_distribution_get(main_dist, numnodes=ncores) + IF (ncores .GT. 1) THEN + CPABORT("serial code only") + ENDIF + + nblkrows_tot = dbcsr_nblkrows_total(quench_t) + nblkcols_tot = dbcsr_nblkcols_total(quench_t) + CPASSERT(nblkrows_tot == nblkcols_tot) + CALL dbcsr_get_info(quench_t, row_blk_size=ao_blk_sizes) + CALL dbcsr_get_info(quench_t, col_blk_size=mo_blk_sizes) + ALLOCATE (mo_block_sizes(nblkcols_tot), ao_block_sizes(nblkcols_tot)) + ALLOCATE (ao_domain_sizes(nblkcols_tot)) + mo_block_sizes(:) = mo_blk_sizes(:) + ao_block_sizes(:) = ao_blk_sizes(:) + ao_domain_sizes(:) = 0 + + CALL dbcsr_create(matrix_S_ao_sym, & + template=matrix_S_ao, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_desymmetrize(matrix_S_ao, matrix_S_ao_sym) + CALL dbcsr_scale(matrix_S_ao_sym, 2.0_dp*spin_factor) + + CALL dbcsr_create(matrix_F_ao_sym, & + template=matrix_F_ao, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_desymmetrize(matrix_F_ao, matrix_F_ao_sym) + CALL dbcsr_scale(matrix_F_ao_sym, 2.0_dp*spin_factor) + + CALL dbcsr_create(matrix_S_mo_sym, & + template=matrix_S_mo, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_desymmetrize(matrix_S_mo, matrix_S_mo_sym) + + CALL dbcsr_create(matrix_F_mo_sym, & + template=matrix_F_mo, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_desymmetrize(matrix_F_mo, matrix_F_mo_sym) + + IF (penalty_occ_vol) THEN + penalty_prefactor_local = penalty_occ_vol_prefactor/(2.0_dp*spin_factor) + ELSE + penalty_prefactor_local = 0.0_dp + ENDIF + + WRITE (*, *) "penalty_prefactor_local: ", penalty_prefactor_local + WRITE (*, *) "penalty_prefactor_2: ", penalty_occ_vol_pf2 + + !CALL dbcsr_print(matrix_grad) + !CALL dbcsr_print(matrix_F_ao_sym) + !CALL dbcsr_print(matrix_S_ao_sym) + !CALL dbcsr_print(matrix_F_mo_sym) + !CALL dbcsr_print(matrix_S_mo_sym) + + ! loop over domains to find the size of the Hessian + H_size = 0 + DO col = 1, nblkcols_tot + + ! find sizes of AO submatrices + DO row = 1, nblkrows_tot + + CALL dbcsr_get_block_p(quench_t, & + row, col, block_p, found) + IF (found) THEN + ao_domain_sizes(col) = ao_domain_sizes(col)+ao_blk_sizes(row) + ENDIF + + ENDDO + + H_size = H_size+ao_domain_sizes(col)*mo_block_sizes(col) + + ENDDO + + ALLOCATE (H(H_size, H_size)) + H(:, :) = 0.0_dp + + ! fill the Hessian matrix + lev1_vert_offset = 0 + ! loop over all pairs of fragments + DO row = 1, nblkcols_tot + + lev1_hori_offset = 0 + DO col = 1, nblkcols_tot + + ! prepare blocks for the current row-column fragment pair + ALLOCATE (F_ao_block(ao_domain_sizes(row), ao_domain_sizes(col))) + ALLOCATE (S_ao_block(ao_domain_sizes(row), ao_domain_sizes(col))) + ALLOCATE (F_mo_block(mo_block_sizes(row), mo_block_sizes(col))) + ALLOCATE (S_mo_block(mo_block_sizes(row), mo_block_sizes(col))) + + F_ao_block(:, :) = 0.0_dp + S_ao_block(:, :) = 0.0_dp + F_mo_block(:, :) = 0.0_dp + S_mo_block(:, :) = 0.0_dp + + ! fill AO submatrices + ! loop over all blocks of the AO dbcsr matrix + ao_vert_offset = 0 + DO block_row = 1, nblkcols_tot + + CALL dbcsr_get_block_p(quench_t, & + block_row, row, block_p, found_row) + IF (found_row) THEN + + ao_hori_offset = 0 + DO block_col = 1, nblkcols_tot + + CALL dbcsr_get_block_p(quench_t, & + block_col, col, block_p, found_col) + IF (found_col) THEN + + CALL dbcsr_get_block_p(matrix_F_ao_sym, & + block_row, block_col, block_p, found) + IF (found) THEN + ! copy the block into the submatrix + F_ao_block(ao_vert_offset+1:ao_vert_offset+ao_block_sizes(block_row), & + ao_hori_offset+1:ao_hori_offset+ao_block_sizes(block_col)) & + = block_p(:, :) + ENDIF + + CALL dbcsr_get_block_p(matrix_S_ao_sym, & + block_row, block_col, block_p, found) + IF (found) THEN + ! copy the block into the submatrix + S_ao_block(ao_vert_offset+1:ao_vert_offset+ao_block_sizes(block_row), & + ao_hori_offset+1:ao_hori_offset+ao_block_sizes(block_col)) & + = block_p(:, :) + ENDIF + + ao_hori_offset = ao_hori_offset+ao_block_sizes(block_col) + + ENDIF + + ENDDO + + ao_vert_offset = ao_vert_offset+ao_block_sizes(block_row) + + ENDIF + + ENDDO + + ! fill MO submatrices + CALL dbcsr_get_block_p(matrix_F_mo_sym, row, col, block_p, found) + IF (found) THEN + ! copy the block into the submatrix + F_mo_block(1:mo_block_sizes(row), 1:mo_block_sizes(col)) = block_p(:, :) + ENDIF + CALL dbcsr_get_block_p(matrix_S_mo_sym, row, col, block_p, found) + IF (found) THEN + ! copy the block into the submatrix + S_mo_block(1:mo_block_sizes(row), 1:mo_block_sizes(col)) = block_p(:, :) + ENDIF + + !WRITE(*,*) "F_AO_BLOCK", row, col, ao_domain_sizes(row), ao_domain_sizes(col) + !DO ii=1,ao_domain_sizes(row) + ! WRITE(*,'(100F13.9)') F_ao_block(ii,:) + !ENDDO + !WRITE(*,*) "S_AO_BLOCK", row, col + !DO ii=1,ao_domain_sizes(row) + ! WRITE(*,'(100F13.9)') S_ao_block(ii,:) + !ENDDO + !WRITE(*,*) "F_MO_BLOCK", row, col + !DO ii=1,mo_block_sizes(row) + ! WRITE(*,'(100F13.9)') F_mo_block(ii,:) + !ENDDO + !WRITE(*,*) "S_MO_BLOCK", row, col, mo_block_sizes(row), mo_block_sizes(col) + !DO ii=1,mo_block_sizes(row) + ! WRITE(*,'(100F13.9)') S_mo_block(ii,:) + !ENDDO + + ! construct tensor products for the current row-column fragment pair + lev2_vert_offset = 0 + DO orb_j = 1, mo_block_sizes(row) + + lev2_hori_offset = 0 + DO orb_i = 1, mo_block_sizes(col) + IF (orb_i .EQ. orb_j .AND. row .EQ. col) THEN + H(lev1_vert_offset+lev2_vert_offset+1:lev1_vert_offset+lev2_vert_offset+ao_domain_sizes(row), & + lev1_hori_offset+lev2_hori_offset+1:lev1_hori_offset+lev2_hori_offset+ao_domain_sizes(col)) & + != -penalty_prefactor_local*S_ao_block(:,:) + = F_ao_block(:, :)+S_ao_block(:, :) +!=S_ao_block(:,:) +!RZK-warning =F_ao_block(:,:)+( 1.0_dp + penalty_prefactor_local )*S_ao_block(:,:) +! =S_mo_block(orb_j,orb_i)*F_ao_block(:,:)& +! -F_mo_block(orb_j,orb_i)*S_ao_block(:,:)& +! +penalty_prefactor_local*S_mo_block(orb_j,orb_i)*S_ao_block(:,:) + ENDIF + !WRITE(*,*) row, col, orb_j, orb_i, lev1_vert_offset+lev2_vert_offset+1, ao_domain_sizes(row),& + ! lev1_hori_offset+lev2_hori_offset+1, ao_domain_sizes(col), S_mo_block(orb_j,orb_i) + + lev2_hori_offset = lev2_hori_offset+ao_domain_sizes(col) + + ENDDO + + lev2_vert_offset = lev2_vert_offset+ao_domain_sizes(row) + + ENDDO + + lev1_hori_offset = lev1_hori_offset+ao_domain_sizes(col)*mo_block_sizes(col) + + DEALLOCATE (F_ao_block) + DEALLOCATE (S_ao_block) + DEALLOCATE (F_mo_block) + DEALLOCATE (S_mo_block) + + ENDDO ! col fragment + + lev1_vert_offset = lev1_vert_offset+ao_domain_sizes(row)*mo_block_sizes(row) + + ENDDO ! row fragment + + CALL dbcsr_release(matrix_S_ao_sym) + CALL dbcsr_release(matrix_F_ao_sym) + CALL dbcsr_release(matrix_S_mo_sym) + CALL dbcsr_release(matrix_F_mo_sym) + +!! ! Two more terms of the Hessian: S_vo.D.F_vo and F_vo.D.S_vo +!! ! It seems that these terms break positive definite property of the Hessian +!! ALLOCATE(H1(H_size,H_size)) +!! ALLOCATE(H2(H_size,H_size)) +!! H1=0.0_dp +!! H2=0.0_dp +!! DO row = 1, nblkcols_tot +!! +!! lev1_hori_offset=0 +!! DO col = 1, nblkcols_tot +!! +!! CALL dbcsr_get_block_p(matrix_F_vo,& +!! row, col, block_p, found) +!! CALL dbcsr_get_block_p(matrix_S_vo,& +!! row, col, block_p2, found2) +!! +!! lev1_vert_offset=0 +!! DO block_col = 1, nblkcols_tot +!! +!! CALL dbcsr_get_block_p(quench_t,& +!! row, block_col, p_new_block, found_row) +!! +!! IF (found_row) THEN +!! +!! ! determine offset in this short loop +!! lev2_vert_offset=0 +!! DO block_row=1,row-1 +!! CALL dbcsr_get_block_p(quench_t,& +!! block_row, block_col, p_new_block, found_col) +!! IF (found_col) lev2_vert_offset=lev2_vert_offset+ao_block_sizes(block_row) +!! ENDDO +!! !!!!!!!! short loop +!! +!! ! over all electrons of the block +!! DO orb_i=1, mo_block_sizes(col) +!! +!! ! into all possible locations +!! DO orb_j=1, mo_block_sizes(block_col) +!! +!! ! column is copied several times +!! DO copy=1, ao_domain_sizes(col) +!! +!! IF (found) THEN +!! +!! !WRITE(*,*) row, col, block_col, orb_i, orb_j, copy,& +!! ! lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+1,& +!! ! lev1_hori_offset+(orb_i-1)*ao_domain_sizes(col)+copy +!! +!! H1( lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+1:& +!! lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+ao_block_sizes(row),& +!! lev1_hori_offset+(orb_i-1)*ao_domain_sizes(col)+copy )& +!! =block_p(:,orb_i) +!! +!! ENDIF ! found block in the data matrix +!! +!! IF (found2) THEN +!! +!! H2( lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+1:& +!! lev1_vert_offset+(orb_j-1)*ao_domain_sizes(block_col)+lev2_vert_offset+ao_block_sizes(row),& +!! lev1_hori_offset+(orb_i-1)*ao_domain_sizes(col)+copy )& +!! =block_p2(:,orb_i) +!! +!! ENDIF ! found block in the data matrix +!! +!! ENDDO +!! +!! ENDDO +!! +!! ENDDO +!! +!! !lev2_vert_offset=lev2_vert_offset+ao_block_sizes(row) +!! +!! ENDIF ! found block in the quench matrix +!! +!! lev1_vert_offset=lev1_vert_offset+& +!! ao_domain_sizes(block_col)*mo_block_sizes(block_col) +!! +!! ENDDO +!! +!! lev1_hori_offset=lev1_hori_offset+& +!! ao_domain_sizes(col)*mo_block_sizes(col) +!! +!! ENDDO +!! +!! !lev2_vert_offset=lev2_vert_offset+ao_block_sizes(row) +!! +!! ENDDO +!! H1(:,:)=H1(:,:)*2.0_dp*spin_factor +!! !!!WRITE(*,*) "F_vo" +!! !!!DO ii=1,H_size +!! !!! WRITE(*,'(100F13.9)') H1(ii,:) +!! !!!ENDDO +!! !!!WRITE(*,*) "S_vo" +!! !!!DO ii=1,H_size +!! !!! WRITE(*,'(100F13.9)') H2(ii,:) +!! !!!ENDDO +!! !!!!! add terms to the hessian +!! DO ii=1,H_size +!! DO jj=1,H_size +!!! add penalty_occ_vol term +!! H(ii,jj)=H(ii,jj)-H1(ii,jj)*H2(jj,ii)-H1(jj,ii)*H2(ii,jj) +!! ENDDO +!! ENDDO +!! DEALLOCATE(H1) +!! DEALLOCATE(H2) + +!! ! S_vo.S_vo diagonal component due to determiant constraint +!! ! use grad vector temporarily +!! IF (penalty_occ_vol) THEN +!! ALLOCATE(Grad_vec(H_size)) +!! Grad_vec(:)=0.0_dp +!! lev1_vert_offset=0 +!! ! loop over all electron blocks +!! DO col = 1, nblkcols_tot +!! +!! ! loop over AO-rows of the dbcsr matrix +!! lev2_vert_offset=0 +!! DO row = 1, nblkrows_tot +!! +!! CALL dbcsr_get_block_p(quench_t,& +!! row, col, block_p, found_row) +!! IF (found_row) THEN +!! +!! CALL dbcsr_get_block_p(matrix_S_vo,& +!! row, col, block_p, found) +!! IF (found) THEN +!! ! copy the data into the vector, column by column +!! DO orb_i=1, mo_block_sizes(col) +!! Grad_vec(lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1:& +!! lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+ao_block_sizes(row))& +!! =block_p(:,orb_i) +!! ENDDO +!! +!! ENDIF +!! +!! lev2_vert_offset=lev2_vert_offset+ao_block_sizes(row) +!! +!! ENDIF +!! +!! ENDDO +!! +!! lev1_vert_offset=lev1_vert_offset+ao_domain_sizes(col)*mo_block_sizes(col) +!! +!! ENDDO ! loop over electron blocks +!! ! update H now +!! DO ii=1,H_size +!! DO jj=1,H_size +!! H(ii,jj)=H(ii,jj)+penalty_occ_vol_prefactor*& +!! penalty_occ_vol_pf2*Grad_vec(ii)*Grad_vec(jj) +!! ENDDO +!! ENDDO +!! DEALLOCATE(Grad_vec) +!! ENDIF ! penalty_occ_vol + +!S-1.G ! invert S using cholesky +!S-1.G CALL dbcsr_create(m_prec_out,& +!S-1.G template=m_s,& +!S-1.G matrix_type=dbcsr_type_no_symmetry) +!S-1.G CALL dbcsr_copy(m_prec_out,m_s) +!S-1.G CALL dbcsr_cholesky_decompose(m_prec_out,& +!S-1.G para_env=para_env,& +!S-1.G blacs_env=blacs_env) +!S-1.G CALL dbcsr_cholesky_invert(m_prec_out,& +!S-1.G para_env=para_env,& +!S-1.G blacs_env=blacs_env,& +!S-1.G upper_to_full=.TRUE.) +!S-1.G CALL dbcsr_multiply("N","N",1.0_dp,& +!S-1.G m_prec_out,& +!S-1.G matrix_grad,& +!S-1.G 0.0_dp,matrix_step,& +!S-1.G filter_eps=1.0E-10_dp) +!S-1.G !CALL dbcsr_release(m_prec_out) +!S-1.G ALLOCATE(test3(H_size)) + + ! convert gradient from the dbcsr matrix to the vector form + ALLOCATE (Grad_vec(H_size)) + Grad_vec(:) = 0.0_dp + lev1_vert_offset = 0 + ! loop over all electron blocks + DO col = 1, nblkcols_tot + + ! loop over AO-rows of the dbcsr matrix + lev2_vert_offset = 0 + DO row = 1, nblkrows_tot + + CALL dbcsr_get_block_p(quench_t, & + row, col, block_p, found_row) + IF (found_row) THEN + + CALL dbcsr_get_block_p(matrix_grad, & + row, col, block_p, found) + IF (found) THEN + ! copy the data into the vector, column by column + DO orb_i = 1, mo_block_sizes(col) + Grad_vec(lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1: & + lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+ao_block_sizes(row)) & + = block_p(:, orb_i) +!WRITE(*,*) "GRAD: ", row, col, orb_i, lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1, ao_block_sizes(row) + ENDDO + + ENDIF + +!S-1.G CALL dbcsr_get_block_p(matrix_step,& +!S-1.G row, col, block_p, found) +!S-1.G IF (found) THEN +!S-1.G ! copy the data into the vector, column by column +!S-1.G DO orb_i=1, mo_block_sizes(col) +!S-1.G test3(lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1:& +!S-1.G lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+ao_block_sizes(row))& +!S-1.G =block_p(:,orb_i) +!S-1.G ENDDO +!S-1.G ENDIF + + lev2_vert_offset = lev2_vert_offset+ao_block_sizes(row) + + ENDIF + + ENDDO + + lev1_vert_offset = lev1_vert_offset+ao_domain_sizes(col)*mo_block_sizes(col) + + ENDDO ! loop over electron blocks + + !WRITE(*,*) "HESSIAN" + !DO ii=1,H_size + ! WRITE(*,*) ii + ! WRITE(*,'(20F14.10)') H(ii,:) + !ENDDO + + ! invert the Hessian + INFO = 0 + ALLOCATE (Hinv(H_size, H_size)) + Hinv(:, :) = H(:, :) + + ! before inverting diagonalize + ALLOCATE (eigenvalues(H_size)) + ! Query the optimal workspace for dsyev + LWORK = -1 + ALLOCATE (WORK(MAX(1, LWORK))) + CALL DSYEV('V', 'L', H_size, Hinv, H_size, eigenvalues, WORK, LWORK, INFO) + LWORK = INT(WORK(1)) + DEALLOCATE (WORK) + ! Allocate the workspace and solve the eigenproblem + ALLOCATE (WORK(MAX(1, LWORK))) + CALL DSYEV('V', 'L', H_size, Hinv, H_size, eigenvalues, WORK, LWORK, INFO) + IF (INFO .NE. 0) THEN + WRITE (*, *) 'DSYEV ERROR MESSAGE: ', INFO + CPABORT("DSYEV failed") + END IF + DEALLOCATE (WORK) + + ! compute grad vector in the basis of Hessian eigenvectors + ALLOCATE (Step_vec(H_size)) + ! Step_vec contains Grad_vec here + Step_vec(:) = MATMUL(TRANSPOSE(Hinv), Grad_vec) + + ! compute U.tr(U)-1 = error + !ALLOCATE(test(H_size,H_size)) + !test(:,:)=MATMUL(TRANSPOSE(Hinv),Hinv) + !DO ii=1,H_size + ! test(ii,ii)=test(ii,ii)-1.0_dp + !ENDDO + !test_error=0.0_dp + !DO ii=1,H_size + ! DO jj=1,H_size + ! test_error=test_error+test(jj,ii)*test(jj,ii) + ! ENDDO + !ENDDO + !WRITE(*,*) "U.tr(U)-1 error: ", SQRT(test_error) + !DEALLOCATE(test) + + ! invert eigenvalues and use eigenvectors to compute the Hessian inverse + ! project out zero-eigenvalue directions + ALLOCATE (test(H_size, H_size)) + zero_neg_eiv = 0 + DO jj = 1, H_size + WRITE (*, "(I10,F20.10,F20.10)") jj, eigenvalues(jj), Step_vec(jj) + IF (eigenvalues(jj) .GT. eps_zero) THEN + test(jj, :) = Hinv(:, jj)/eigenvalues(jj) + ELSE + test(jj, :) = Hinv(:, jj)*0.0_dp + zero_neg_eiv = zero_neg_eiv+1 + ENDIF + ENDDO + WRITE (*, *) 'ZERO OR NEGATIVE EIGENVALUES: ', zero_neg_eiv + DEALLOCATE (Step_vec) + + ALLOCATE (test2(H_size, H_size)) + test2(:, :) = MATMUL(Hinv, test) + Hinv(:, :) = test2(:, :) + DEALLOCATE (test, test2) + + !! shift to kill singularity + !shift=0.0_dp + !IF (eigenvalues(1).lt.0.0_dp) THEN + ! CPABORT("Negative eigenvalue(s)") + ! shift=abs(eigenvalues(1)) + ! WRITE(*,*) "Lowest eigenvalue: ", eigenvalues(1) + !ENDIF + !DO ii=1, H_size + ! IF (eigenvalues(ii).gt.eps_zero) THEN + ! shift=shift+min(1.0_dp,eigenvalues(ii))*1.0E-4_dp + ! EXIT + ! ENDIF + !ENDDO + !WRITE(*,*) "Hessian shift: ", shift + !DO ii=1, H_size + ! H(ii,ii)=H(ii,ii)+shift + !ENDDO + !! end shift + + DEALLOCATE (eigenvalues) + +!!!! Hinv=H +!!!! INFO=0 +!!!! CALL DPOTRF('L', H_size, Hinv, H_size, INFO ) +!!!! IF( INFO.NE.0 ) THEN +!!!! WRITE(*,*) 'DPOTRF ERROR MESSAGE: ', INFO +!!!! CPABORT("DPOTRF failed") +!!!! END IF +!!!! CALL DPOTRI('L', H_size, Hinv, H_size, INFO ) +!!!! IF( INFO.NE.0 ) THEN +!!!! WRITE(*,*) 'DPOTRI ERROR MESSAGE: ', INFO +!!!! CPABORT("DPOTRI failed") +!!!! END IF +!!!! ! complete the matrix +!!!! DO ii=1,H_size +!!!! DO jj=ii+1,H_size +!!!! Hinv(ii,jj)=Hinv(jj,ii) +!!!! ENDDO +!!!! ENDDO + + ! compute the inversion error + ALLOCATE (test(H_size, H_size)) + test(:, :) = MATMUL(Hinv, H) + DO ii = 1, H_size + test(ii, ii) = test(ii, ii)-1.0_dp + ENDDO + test_error = 0.0_dp + DO ii = 1, H_size + DO jj = 1, H_size + test_error = test_error+test(jj, ii)*test(jj, ii) + ENDDO + ENDDO + WRITE (*, *) "Hessian inversion error: ", SQRT(test_error) + DEALLOCATE (test) + + ! prepare the output vector + ALLOCATE (Step_vec(H_size)) + ALLOCATE (tmp(H_size)) + tmp(:) = MATMUL(Hinv, Grad_vec) + !tmp(:)=MATMUL(Hinv,test3) + Step_vec(:) = -1.0_dp*tmp(:) + + ALLOCATE (tmpr(H_size)) + tmpr(:) = MATMUL(H, Step_vec) + tmp(:) = tmpr(:)+Grad_vec(:) + DEALLOCATE (tmpr) + WRITE (*, *) "NEWTOV step error: ", MAXVAL(ABS(tmp)) + + DEALLOCATE (tmp) + + DEALLOCATE (H) + DEALLOCATE (Hinv) + DEALLOCATE (Grad_vec) + +!S-1.G DEALLOCATE(test3) + + ! copy the step from the vector into the dbcsr matrix + + ! re-create the step matrix to remove all blocks + CALL dbcsr_create(matrix_step, & + template=matrix_grad, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_work_create(matrix_step, work_mutable=.TRUE.) + + lev1_vert_offset = 0 + ! loop over all electron blocks + DO col = 1, nblkcols_tot + + ! loop over AO-rows of the dbcsr matrix + lev2_vert_offset = 0 + DO row = 1, nblkrows_tot + + CALL dbcsr_get_block_p(quench_t, & + row, col, block_p, found_row) + IF (found_row) THEN + + NULLIFY (p_new_block) + CALL dbcsr_reserve_block2d(matrix_step, row, col, p_new_block) + CPASSERT(ASSOCIATED(p_new_block)) + ! copy the data column by column + DO orb_i = 1, mo_block_sizes(col) + p_new_block(:, orb_i) = & + Step_vec(lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+1: & + lev1_vert_offset+ao_domain_sizes(col)*(orb_i-1)+lev2_vert_offset+ao_block_sizes(row)) + ENDDO + + lev2_vert_offset = lev2_vert_offset+ao_block_sizes(row) + + ENDIF + + ENDDO + + lev1_vert_offset = lev1_vert_offset+ao_domain_sizes(col)*mo_block_sizes(col) + + ENDDO ! loop over electron blocks + + DEALLOCATE (Step_vec) + + CALL dbcsr_finalize(matrix_step) + +!S-1.G CALL dbcsr_create(m_tmp_no_1,& +!S-1.G template=matrix_step,& +!S-1.G matrix_type=dbcsr_type_no_symmetry) +!S-1.G CALL dbcsr_multiply("N","N",1.0_dp,& +!S-1.G m_prec_out,& +!S-1.G matrix_step,& +!S-1.G 0.0_dp,m_tmp_no_1,& +!S-1.G filter_eps=1.0E-10_dp,& +!S-1.G ) +!S-1.G CALL dbcsr_copy(matrix_step,m_tmp_no_1) +!S-1.G CALL dbcsr_release(m_tmp_no_1) +!S-1.G CALL dbcsr_release(m_prec_out) + + DEALLOCATE (mo_block_sizes, ao_block_sizes) + DEALLOCATE (ao_domain_sizes) + + CALL dbcsr_create(matrix_S_ao_sym, & + template=quench_t, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_copy(matrix_S_ao_sym, quench_t) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + matrix_F_ao, & + matrix_step, & + 0.0_dp, matrix_S_ao_sym, & + retain_sparsity=.TRUE.) + CALL dbcsr_create(matrix_F_ao_sym, & + template=quench_t, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_copy(matrix_F_ao_sym, quench_t) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + matrix_S_ao, & + matrix_step, & + 0.0_dp, matrix_F_ao_sym, & + retain_sparsity=.TRUE.) + CALL dbcsr_add(matrix_S_ao_sym, matrix_F_ao_sym, & + 1.0_dp, 1.0_dp) + CALL dbcsr_scale(matrix_S_ao_sym, 2.0_dp*spin_factor) + CALL dbcsr_add(matrix_S_ao_sym, matrix_grad, & + 1.0_dp, 1.0_dp) + CALL dbcsr_norm(matrix_S_ao_sym, dbcsr_norm_maxabsnorm, & + norm_scalar=test_error) + WRITE (*, *) "NEWTOL step error: ", test_error + CALL dbcsr_release(matrix_S_ao_sym) + CALL dbcsr_release(matrix_F_ao_sym) + + CALL timestop(handle) + + END SUBROUTINE hessian_diag_apply + END MODULE almo_scf_optimizer diff --git a/src/almo_scf_qs.F b/src/almo_scf_qs.F index 6058ef0deb..9e6efc41c1 100644 --- a/src/almo_scf_qs.F +++ b/src/almo_scf_qs.F @@ -72,7 +72,6 @@ MODULE almo_scf_qs USE qs_rho_methods, ONLY: qs_rho_update_rho USE qs_rho_types, ONLY: qs_rho_get,& qs_rho_type - USE qs_scf_initialization, ONLY: qs_scf_env_initialize USE qs_scf_types, ONLY: qs_scf_env_type,& scf_env_create #include "./base/base_uses.f90" @@ -83,10 +82,15 @@ MODULE almo_scf_qs CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'almo_scf_qs' - PUBLIC :: almo_scf_init_qs, matrix_almo_create, matrix_qs_to_almo, & - almo_scf_dm_to_ks, calculate_w_matrix_almo, & - almo_scf_construct_quencher, almo_scf_update_ks_energy, & - matrix_almo_to_qs + PUBLIC :: matrix_almo_create, & + almo_scf_construct_quencher, & + calculate_w_matrix_almo, & + init_almo_ks_matrix_via_qs, & + almo_scf_update_ks_energy, & + construct_qs_mos, & + matrix_qs_to_almo, & + almo_dm_to_almo_ks, & + almo_dm_to_qs_env CONTAINS @@ -125,7 +129,7 @@ CONTAINS INTEGER, DIMENSION(:), POINTER :: blk_distr, blk_sizes, block_sizes_new, cluster_distr, & cluster_distr_new, col_cluster_new, col_distr_new, col_sizes_new, distr_new_array, & row_cluster_new, row_distr_new, row_sizes_new - LOGICAL :: active, tr + LOGICAL :: active, one_dim_is_mo, tr REAL(KIND=dp), DIMENSION(:, :), POINTER :: p_new_block TYPE(dbcsr_distribution_type) :: dist_new, dist_qs @@ -233,6 +237,9 @@ CONTAINS ALLOCATE (block_sizes_new(nlength)) IF (size_keys(dimen) == almo_mat_dim_occ) THEN block_sizes_new(:) = almo_scf_env%nocc_of_domain(:, spin_key) + ! Handle zero-electron fragments by adding one-orbital that + ! must remain zero at all times + WHERE (block_sizes_new == 0) block_sizes_new = 1 ELSE IF (size_keys(dimen) == almo_mat_dim_virt_disc) THEN block_sizes_new(:) = almo_scf_env%nvirt_disc_of_domain(:, spin_key) ELSE IF (size_keys(dimen) == almo_mat_dim_virt_full) THEN @@ -363,6 +370,7 @@ CONTAINS !QQQ ENDIF ! mynode !QQQ ENDDO !QQQENDDO + !QQQtake care of zero-electron fragments ! endQQQ - end of the quadratic part ! start linear-scaling replacement: ! works only for molecular blocks AND molecular distributions @@ -377,6 +385,30 @@ CONTAINS active = .TRUE. + one_dim_is_mo = .FALSE. + DO dimen = 1, 2 ! 1 - row, 2 - column dimension + IF (size_keys(dimen) == almo_mat_dim_occ) one_dim_is_mo = .TRUE. + ENDDO + IF (one_dim_is_mo .AND. almo_scf_env%nocc_of_domain(row, spin_key) == 0) active = .FALSE. + + one_dim_is_mo = .FALSE. + DO dimen = 1, 2 + IF (size_keys(dimen) == almo_mat_dim_virt) one_dim_is_mo = .TRUE. + ENDDO + IF (one_dim_is_mo .AND. almo_scf_env%nvirt_of_domain(row, spin_key) == 0) active = .FALSE. + + one_dim_is_mo = .FALSE. + DO dimen = 1, 2 + IF (size_keys(dimen) == almo_mat_dim_virt_disc) one_dim_is_mo = .TRUE. + ENDDO + IF (one_dim_is_mo .AND. almo_scf_env%nvirt_disc_of_domain(row, spin_key) == 0) active = .FALSE. + + one_dim_is_mo = .FALSE. + DO dimen = 1, 2 + IF (size_keys(dimen) == almo_mat_dim_virt_full) one_dim_is_mo = .TRUE. + ENDDO + IF (one_dim_is_mo .AND. almo_scf_env%nvirt_full_of_domain(row, spin_key) == 0) active = .FALSE. + IF (active) THEN NULLIFY (p_new_block) CALL dbcsr_reserve_block2d(matrix_new, iblock_row, iblock_col, p_new_block) @@ -400,16 +432,16 @@ CONTAINS !> \brief convert between two types of matrices: QS style to ALMO style !> \param matrix_qs ... !> \param matrix_almo ... -!> \param almo_scf_env ... +!> \param mat_distr_aos ... !> \param keep_sparsity ... !> \par History !> 2011.06 created [Rustam Z Khaliullin] !> \author Rustam Z Khaliullin ! ************************************************************************************************** - SUBROUTINE matrix_qs_to_almo(matrix_qs, matrix_almo, almo_scf_env, & - keep_sparsity) + SUBROUTINE matrix_qs_to_almo(matrix_qs, matrix_almo, mat_distr_aos, keep_sparsity) + TYPE(dbcsr_type) :: matrix_qs, matrix_almo - TYPE(almo_scf_env_type) :: almo_scf_env + INTEGER :: mat_distr_aos LOGICAL, INTENT(IN) :: keep_sparsity CHARACTER(len=*), PARAMETER :: routineN = 'matrix_qs_to_almo', & @@ -421,7 +453,7 @@ CONTAINS CALL timeset(routineN, handle) !RZK-warning if it's not a N(AO)xN(AO) matrix then stop - SELECT CASE (almo_scf_env%mat_distr_aos) + SELECT CASE (mat_distr_aos) CASE (almo_mat_distr_atomic) ! automatic data_type conversion CALL dbcsr_copy(matrix_almo, matrix_qs, & @@ -456,14 +488,14 @@ CONTAINS !> \brief convert between two types of matrices: ALMO style to QS style !> \param matrix_almo ... !> \param matrix_qs ... -!> \param almo_scf_env ... +!> \param mat_distr_aos ... !> \par History !> 2011.06 created [Rustam Z Khaliullin] !> \author Rustam Z Khaliullin ! ************************************************************************************************** - SUBROUTINE matrix_almo_to_qs(matrix_almo, matrix_qs, almo_scf_env) + SUBROUTINE matrix_almo_to_qs(matrix_almo, matrix_qs, mat_distr_aos) TYPE(dbcsr_type) :: matrix_almo, matrix_qs - TYPE(almo_scf_env_type), INTENT(IN) :: almo_scf_env + INTEGER, INTENT(IN) :: mat_distr_aos CHARACTER(len=*), PARAMETER :: routineN = 'matrix_almo_to_qs', & routineP = moduleN//':'//routineN @@ -473,66 +505,46 @@ CONTAINS CALL timeset(routineN, handle) ! RZK-warning if it's not a N(AO)xN(AO) matrix then stop -! IF (ls_mstruct%single_precision) THEN -! CALL dbcsr_init (matrix_tmp) -! CALL dbcsr_create (matrix_tmp, template=matrix_ls,& -! data_type=dbcsr_type_real_8) -! CALL dbcsr_copy (matrix_tmp, matrix_ls) -! ENDIF - - SELECT CASE (almo_scf_env%mat_distr_aos) + SELECT CASE (mat_distr_aos) CASE (almo_mat_distr_atomic) -! IF (ls_mstruct%single_precision) THEN -! CALL dbcsr_copy_into_existing (matrix_qs, matrix_tmp) -! ELSE CALL dbcsr_copy_into_existing(matrix_qs, matrix_almo) -! ENDIF CASE (almo_mat_distr_molecular) CALL dbcsr_set(matrix_qs, 0.0_dp) -! IF (ls_mstruct%single_precision) THEN -! CALL dbcsr_complete_redistribute(matrix_tmp, matrix_qs, keep_sparsity=.TRUE.) -! ELSE CALL dbcsr_complete_redistribute(matrix_almo, matrix_qs, keep_sparsity=.TRUE.) -! ENDIF CASE DEFAULT CPABORT("") END SELECT -! IF (ls_mstruct%single_precision) THEN -! CALL dbcsr_release(matrix_tmp) -! ENDIF - CALL timestop(handle) END SUBROUTINE matrix_almo_to_qs ! ************************************************************************************************** -!> \brief Initialization of QS and ALMOs -!> Some parts can be factored-out since they are common -!> for the other SCF methods +!> \brief Initialization of the QS and ALMO KS matrix !> \param qs_env ... -!> \param almo_scf_env ... +!> \param matrix_ks ... +!> \param mat_distr_aos ... +!> \param eps_filter ... !> \par History !> 2011.05 created [Rustam Z Khaliullin] !> \author Rustam Z Khaliullin ! ************************************************************************************************** - SUBROUTINE almo_scf_init_qs(qs_env, almo_scf_env) - TYPE(qs_environment_type), POINTER :: qs_env - TYPE(almo_scf_env_type) :: almo_scf_env + SUBROUTINE init_almo_ks_matrix_via_qs(qs_env, matrix_ks, mat_distr_aos, eps_filter) - CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_init_qs', & + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(dbcsr_type), DIMENSION(:) :: matrix_ks + INTEGER :: mat_distr_aos + REAL(KIND=dp) :: eps_filter + + CHARACTER(len=*), PARAMETER :: routineN = 'init_almo_ks_matrix_via_qs', & routineP = moduleN//':'//routineN - INTEGER :: handle, ispin, ncol_fm, nrow_fm, nspin - TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp - TYPE(cp_fm_type), POINTER :: mo_fm_copy - TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_s + INTEGER :: handle, ispin, nspin + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_qs_ks, matrix_qs_s TYPE(dft_control_type), POINTER :: dft_control - TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos TYPE(neighbor_list_set_p_type), DIMENSION(:), & POINTER :: sab_orb TYPE(qs_ks_env_type), POINTER :: ks_env - TYPE(qs_scf_env_type), POINTER :: scf_env CALL timeset(routineN, handle) @@ -541,33 +553,69 @@ CONTAINS ! get basic quantities from the qs_env CALL get_qs_env(qs_env, & dft_control=dft_control, & - matrix_s=matrix_s, & - matrix_ks=matrix_ks, & + matrix_s=matrix_qs_s, & + matrix_ks=matrix_qs_ks, & ks_env=ks_env, & sab_orb=sab_orb) nspin = dft_control%nspins - ! create matrix_ks if necessary - IF (.NOT. ASSOCIATED(matrix_ks)) THEN - CALL dbcsr_allocate_matrix_set(matrix_ks, nspin) + ! create matrix_ks in the QS env if necessary + IF (.NOT. ASSOCIATED(matrix_qs_ks)) THEN + CALL dbcsr_allocate_matrix_set(matrix_qs_ks, nspin) DO ispin = 1, nspin - ALLOCATE (matrix_ks(ispin)%matrix) - CALL dbcsr_create(matrix_ks(ispin)%matrix, & - template=matrix_s(1)%matrix) - CALL cp_dbcsr_alloc_block_from_nbl(matrix_ks(ispin)%matrix, sab_orb) - CALL dbcsr_set(matrix_ks(ispin)%matrix, 0.0_dp) + ALLOCATE (matrix_qs_ks(ispin)%matrix) + CALL dbcsr_create(matrix_qs_ks(ispin)%matrix, & + template=matrix_qs_s(1)%matrix) + CALL cp_dbcsr_alloc_block_from_nbl(matrix_qs_ks(ispin)%matrix, sab_orb) + CALL dbcsr_set(matrix_qs_ks(ispin)%matrix, 0.0_dp) ENDDO - CALL set_ks_env(ks_env, matrix_ks=matrix_ks) + CALL set_ks_env(ks_env, matrix_ks=matrix_qs_ks) ENDIF + ! copy to ALMO + DO ispin = 1, nspin + CALL matrix_qs_to_almo(matrix_qs_ks(ispin)%matrix, & + matrix_ks(ispin), mat_distr_aos, .FALSE.) + CALL dbcsr_filter(matrix_ks(ispin), eps_filter) + ENDDO + + CALL timestop(handle) + + END SUBROUTINE init_almo_ks_matrix_via_qs + +! ************************************************************************************************** +!> \brief Create MOs in the QS env to be able to return ALMOs to QS +!> \param qs_env ... +!> \param almo_scf_env ... +!> \par History +!> 2016.12 created [Yifei Shi] +!> \author Yifei Shi +! ************************************************************************************************** + SUBROUTINE construct_qs_mos(qs_env, almo_scf_env) + + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(almo_scf_env_type), INTENT(INOUT) :: almo_scf_env + + CHARACTER(len=*), PARAMETER :: routineN = 'construct_qs_mos', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ispin, ncol_fm, nrow_fm + TYPE(cp_fm_struct_type), POINTER :: fm_struct_tmp + TYPE(cp_fm_type), POINTER :: mo_fm_copy + TYPE(dft_control_type), POINTER :: dft_control + TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos + TYPE(qs_scf_env_type), POINTER :: scf_env + + CALL timeset(routineN, handle) + ! create and init scf_env (this is necessary to return MOs to qs) NULLIFY (mos, mo_fm_copy, fm_struct_tmp, scf_env) CALL scf_env_create(scf_env) - CALL qs_scf_env_initialize(qs_env, scf_env) + !CALL qs_scf_env_initialize(qs_env, scf_env) CALL set_qs_env(qs_env, scf_env=scf_env) - CALL get_qs_env(qs_env, mos=mos) + CALL get_qs_env(qs_env, dft_control=dft_control, mos=mos) CALL dbcsr_get_info(almo_scf_env%matrix_t(1), nfullrows_total=nrow_fm, nfullcols_total=ncol_fm) @@ -600,55 +648,131 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE almo_scf_init_qs + END SUBROUTINE construct_qs_mos ! ************************************************************************************************** -!> \brief use the density matrix in almo_scf_env -!> to compute the new energy and KS matrix +!> \brief return density matrix to the qs_env !> \param qs_env ... -!> \param almo_scf_env ... -!> \param energy_new ... +!> \param matrix_p ... +!> \param mat_distr_aos ... !> \par History !> 2011.05 created [Rustam Z Khaliullin] !> \author Rustam Z Khaliullin ! ************************************************************************************************** - SUBROUTINE almo_scf_dm_to_ks(qs_env, almo_scf_env, energy_new) + SUBROUTINE almo_dm_to_qs_env(qs_env, matrix_p, mat_distr_aos) TYPE(qs_environment_type), POINTER :: qs_env - TYPE(almo_scf_env_type) :: almo_scf_env - REAL(KIND=dp) :: energy_new + TYPE(dbcsr_type), DIMENSION(:) :: matrix_p + INTEGER, INTENT(IN) :: mat_distr_aos - CHARACTER(len=*), PARAMETER :: routineN = 'almo_scf_dm_to_ks', & + CHARACTER(len=*), PARAMETER :: routineN = 'almo_dm_to_qs_env', & routineP = moduleN//':'//routineN - INTEGER :: handle, ispin, nspin + INTEGER :: handle, ispin, nspins TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao - TYPE(qs_energy_type), POINTER :: energy TYPE(qs_rho_type), POINTER :: rho - NULLIFY (rho, rho_ao) CALL timeset(routineN, handle) - nspin = almo_scf_env%nspins - CALL get_qs_env(qs_env, energy=energy, rho=rho) + NULLIFY (rho, rho_ao) + nspins = SIZE(matrix_p) + CALL get_qs_env(qs_env, rho=rho) CALL qs_rho_get(rho, rho_ao=rho_ao) ! set the new density matrix - DO ispin = 1, nspin - CALL matrix_almo_to_qs(almo_scf_env%matrix_p(ispin), & + DO ispin = 1, nspins + CALL matrix_almo_to_qs(matrix_p(ispin), & rho_ao(ispin)%matrix, & - almo_scf_env) + mat_distr_aos) END DO - - ! compute the corresponding KS matrix and new energy CALL qs_rho_update_rho(rho, qs_env=qs_env) CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.TRUE.) - CALL qs_ks_update_qs_env(qs_env, calculate_forces=.FALSE., just_energy=.FALSE., & - print_active=.TRUE.) - energy_new = energy%total CALL timestop(handle) - END SUBROUTINE almo_scf_dm_to_ks + END SUBROUTINE almo_dm_to_qs_env + +! ************************************************************************************************** +!> \brief uses the ALMO density matrix +!> to compute KS matrix (inside QS environment) and the new energy +!> \param qs_env ... +!> \param matrix_p ... +!> \param energy_total ... +!> \param mat_distr_aos ... +!> \par History +!> 2011.05 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE almo_dm_to_qs_ks(qs_env, matrix_p, energy_total, mat_distr_aos) + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(dbcsr_type), DIMENSION(:) :: matrix_p + REAL(KIND=dp) :: energy_total + INTEGER, INTENT(IN) :: mat_distr_aos + + CHARACTER(len=*), PARAMETER :: routineN = 'almo_dm_to_qs_ks', & + routineP = moduleN//':'//routineN + + INTEGER :: handle + TYPE(qs_energy_type), POINTER :: energy + + CALL timeset(routineN, handle) + + NULLIFY (energy) + CALL get_qs_env(qs_env, energy=energy) + CALL almo_dm_to_qs_env(qs_env, matrix_p, mat_distr_aos) + CALL qs_ks_update_qs_env(qs_env, calculate_forces=.FALSE., just_energy=.FALSE., & + print_active=.TRUE.) + energy_total = energy%total + + CALL timestop(handle) + + END SUBROUTINE almo_dm_to_qs_ks + +! ************************************************************************************************** +!> \brief uses the ALMO density matrix +!> to compute ALMO KS matrix and the new energy +!> \param qs_env ... +!> \param matrix_p ... +!> \param matrix_ks ... +!> \param energy_total ... +!> \param eps_filter ... +!> \param mat_distr_aos ... +!> \par History +!> 2011.05 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE almo_dm_to_almo_ks(qs_env, matrix_p, matrix_ks, energy_total, eps_filter, & + mat_distr_aos) + + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(dbcsr_type), DIMENSION(:) :: matrix_p, matrix_ks + REAL(KIND=dp) :: energy_total, eps_filter + INTEGER, INTENT(IN) :: mat_distr_aos + + CHARACTER(len=*), PARAMETER :: routineN = 'almo_dm_to_almo_ks', & + routineP = moduleN//':'//routineN + + INTEGER :: handle, ispin, nspins + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_qs_ks + + CALL timeset(routineN, handle) + + ! update KS matrix in the QS env + CALL almo_dm_to_qs_ks(qs_env, matrix_p, energy_total, mat_distr_aos) + + nspins = SIZE(matrix_ks) + + ! get KS matrix from the QS env and convert to the ALMO format + CALL get_qs_env(qs_env, matrix_ks=matrix_qs_ks) + DO ispin = 1, nspins + CALL matrix_qs_to_almo(matrix_qs_ks(ispin)%matrix, & + matrix_ks(ispin), & + mat_distr_aos, .FALSE.) + CALL dbcsr_filter(matrix_ks(ispin), eps_filter) + ENDDO + + CALL timestop(handle) + + END SUBROUTINE almo_dm_to_almo_ks ! ************************************************************************************************** !> \brief update qs_env total energy @@ -845,9 +969,6 @@ CONTAINS ! fifth, communicate all list data ALLOCATE (global_list(global_list_length)) -!WRITE(*,*) "LENGTH: ", list_length_cpu -!WRITE(*,*) "OFFSET: ", list_offset_cpu -!WRITE(*,*) "LOCAL: ", local_list CALL mp_allgather(local_list, global_list, & list_length_cpu, list_offset_cpu, GroupID) DEALLOCATE (list_length_cpu, list_offset_cpu) @@ -920,12 +1041,9 @@ CONTAINS ! O(N) loop over domain pairs DO row = 1, nblkrows_tot DO col = 1, current_number_neighbors(row) - !DO col = 1, nblkcols_tot tr = .FALSE. iblock_row = row iblock_col = domain_neighbor_list(row, col) - !iblock_col = col -!IF (unit_nr>0) WRITE(*,*) iblock_row, iblock_col CALL dbcsr_get_stored_coordinates(almo_scf_env%quench_t(ispin), & iblock_row, iblock_col, hold) @@ -1178,8 +1296,9 @@ CONTAINS contact1_radius = cp_unit_to_cp2k(contact1_radius, "angstrom") contact2_radius = cp_unit_to_cp2k(contact2_radius, "angstrom") -!RZK-warning the procedure is faulty for molecules: the closest contacts should be found using -! the element specific radii + !RZK-warning the procedure is faulty for molecules: + ! the closest contacts should be found using + ! the element specific radii ! compute inner and outer cutoff radii r0 = almo_scf_env%quencher_r0_factor*(contact1_radius+contact2_radius) @@ -1252,12 +1371,6 @@ CONTAINS CPABORT("number of blocks is wrong") ENDIF - ! communicate local parts of the domain map - !nNodes = dbcsr_mp_numnodes(dbcsr_distribution_mp(& - ! dbcsr_distribution(almo_scf_env%quench_t(ispin)))) - !GroupID = dbcsr_mp_group(dbcsr_distribution_mp(& - ! dbcsr_distribution(almo_scf_env%quench_t(ispin)))) - ! first, communicate map sizes on the other nodes ALLOCATE (domain_entries_cpu(nNodes), offset_for_cpu(nNodes)) CALL mp_allgather(2*domain_map_local_entries, domain_entries_cpu, GroupID) @@ -1454,7 +1567,7 @@ CONTAINS ! 6. TMP_NN1=TMP_NO1.T^(tr)=(TsiginvT^(tr)FTsiginv).T^(tr)=RFR CALL dbcsr_multiply("N", "T", 1.0_dp, tmp_no1, almo_scf_env%matrix_t(ispin), & 0.0_dp, tmp_nn1, filter_eps=almo_scf_env%eps_filter) - CALL matrix_almo_to_qs(tmp_nn1, matrix_w(ispin)%matrix, almo_scf_env) + CALL matrix_almo_to_qs(tmp_nn1, matrix_w(ispin)%matrix, almo_scf_env%mat_distr_aos) CALL dbcsr_release(tmp_nn1) CALL dbcsr_release(tmp_no1) diff --git a/src/almo_scf_types.F b/src/almo_scf_types.F index 567ae037f3..2e033811df 100644 --- a/src/almo_scf_types.F +++ b/src/almo_scf_types.F @@ -18,8 +18,8 @@ MODULE almo_scf_types domain_submatrix_type USE input_constants, ONLY: & cg_dai_yuan, cg_fletcher, cg_fletcher_reeves, cg_hager_zhang, cg_hestenes_stiefel, & - cg_liu_storey, cg_polak_ribiere, cg_zero, optimizer_diis, optimizer_pcg, prec_default, & - prec_zero + cg_liu_storey, cg_polak_ribiere, cg_zero, optimizer_diis, optimizer_pcg, & + xalmo_prec_domain, xalmo_prec_full, xalmo_prec_zero USE kinds, ONLY: dp #include "./base/base_uses.f90" @@ -41,6 +41,14 @@ MODULE almo_scf_types print_optimizer_options, almo_scf_env_release, & almo_scf_history_type + ! methods that add penalty terms to the energy functional + TYPE penalty_type + + REAL(KIND=dp) :: occ_vol_coeff + INTEGER :: occ_vol_method + + END TYPE penalty_type + ! almo-based electronic structure analysis TYPE almo_analysis_type @@ -67,17 +75,22 @@ MODULE almo_scf_types !INTEGER :: ndiis_q -> ndiis REAL(KIND=dp) :: eps_error, & + eps_error_early, & lin_search_eps_error, & - lin_search_step_size_guess + lin_search_step_size_guess, & + neglect_threshold INTEGER :: optimizer_type ! diis, pcg, etc. INTEGER :: preconditioner, & ! preconditioner type conjugator, & ! conjugator type max_iter, & + max_iter_early, & max_iter_outer_loop, & ndiis ! diis history length + LOGICAL :: early_stopping_on = .FALSE. + END TYPE optimizer_options_type TYPE almo_scf_history_type @@ -199,13 +212,16 @@ MODULE almo_scf_types LOGICAL :: s_inv_done LOGICAL :: s_sqrt_done REAL(KIND=dp) :: almo_scf_energy - LOGICAL :: orthogonal_basis, fixed_mu + LOGICAL :: orthogonal_basis, fixed_mu + LOGICAL :: return_orthogonalized_mos ! Controls for the SCF procedure REAL(KIND=dp) :: eps_filter + INTEGER :: xalmo_trial_wf INTEGER :: almo_scf_guess REAL(KIND=dp) :: eps_prev_guess INTEGER :: order_lanczos + REAL(KIND=dp) :: matrix_iter_eps_error_factor REAL(KIND=dp) :: eps_lanczos INTEGER :: max_iter_lanczos REAL(KIND=dp) :: mixing_fraction @@ -214,6 +230,8 @@ MODULE almo_scf_types INTEGER :: almo_update_algorithm ! SCF procedure for the quenched ALMOs (xALMOs) INTEGER :: xalmo_update_algorithm + ! mo overlap inversion algorithm + INTEGER :: sigma_inv_algorithm ! ALMO SCF delocalization control LOGICAL :: perturbative_delocalization @@ -328,14 +346,16 @@ MODULE almo_scf_types INTEGER, DIMENSION(:), ALLOCATABLE :: cpu_of_domain - ! Options for various optimizers collected neatly + ! Options for various subsection options collected neatly TYPE(almo_analysis_type) :: almo_analysis + TYPE(penalty_type) :: penalty ! Options for various optimizers collected neatly TYPE(optimizer_options_type) :: opt_block_diag_diis TYPE(optimizer_options_type) :: opt_block_diag_pcg TYPE(optimizer_options_type) :: opt_xalmo_diis TYPE(optimizer_options_type) :: opt_xalmo_pcg + TYPE(optimizer_options_type) :: opt_xalmo_newton_pcg_solver TYPE(optimizer_options_type) :: opt_k_pcg ! keywords that control electron delocalization treatment @@ -433,10 +453,12 @@ CONTAINS optimizer%max_iter_outer_loop SELECT CASE (optimizer%preconditioner) - CASE (prec_zero) + CASE (xalmo_prec_zero) prec_string = "NONE" - CASE (prec_default) - prec_string = "0.5 H + 0.5 S" + CASE (xalmo_prec_domain) + prec_string = "0.5 KS + 0.5 S, DOMAINS" + CASE (xalmo_prec_full) + prec_string = "0.5 KS + 0.5 S, FULL" END SELECT WRITE (unit_nr, '(T4,A,T48,A33)') "preconditioner:", TRIM(prec_string) diff --git a/src/common/bibliography.F b/src/common/bibliography.F index 94f2324f84..07467d4c27 100644 --- a/src/common/bibliography.F +++ b/src/common/bibliography.F @@ -82,7 +82,7 @@ MODULE bibliography Bates2013, Andermatt2016, Zhu2016, Schuett2016, Lu2004, & Becke1988b, Migliore2009, Mavros2015, Holmberg2017, Marek2014, & Stoychev2016, Futera2017, Bailey2006, Papior2017, Lehtola2018, & - Brieuc2016, Barca2018, Huang2011, Heaton_Burgess2007 + Brieuc2016, Barca2018, Scheiber2018, Huang2011, Heaton_Burgess2007 CONTAINS @@ -3863,6 +3863,23 @@ CONTAINS "ER"), & DOI="10.1103/PhysRevLett.98.256401") + CALL add_reference(key=Scheiber2018, ISI_record=s2a( & + "AU Scheiber, H", & + " Shi, Y", & + " Khaliullin, RZ", & + "AF Scheiber, Hayden", & + " Shi, Yifei", & + " Khaliullin, Rustam Z.", & + "TI Compact orbitals enable low-cost linear-scaling ab initio molecular dynamics for weakly-interacting systems", & + "SO The Journal of Chemical Physics", & + "PD JUN 21", & + "PY 2018", & + "VL 148", & + "AR 231103", & + "DI 10.1063/1.5029939", & + "ER"), & + DOI="10.1063/1.5029939") + END SUBROUTINE add_all_references END MODULE bibliography diff --git a/src/input_constants.F b/src/input_constants.F index fd81508f34..adf9047fc7 100644 --- a/src/input_constants.F +++ b/src/input_constants.F @@ -891,7 +891,11 @@ MODULE input_constants INTEGER, PARAMETER, PUBLIC :: almo_scf_dm_sign = 1, & almo_scf_diag = 2, & - almo_scf_pcg = 3 + almo_scf_pcg = 3, & + almo_scf_skip = 4 + + INTEGER, PARAMETER, PUBLIC :: almo_occ_vol_penalty_none = 0, & + almo_occ_vol_penalty_lndet = 1 ! optimizer parameters INTEGER, PARAMETER, PUBLIC :: cg_zero = 0, & @@ -903,13 +907,16 @@ MODULE input_constants cg_dai_yuan = 6, & cg_hager_zhang = 7 INTEGER, PARAMETER, PUBLIC :: optimizer_diis = 1, & - optimizer_pcg = 2 - INTEGER, PARAMETER, PUBLIC :: prec_zero = 0, & - prec_default = -1, & - prec_ks_plus_s = 4 + optimizer_pcg = 2, & + optimizer_lin_eq_pcg = 3 + INTEGER, PARAMETER, PUBLIC :: xalmo_prec_zero = 0, & + xalmo_prec_domain = 1, & + xalmo_prec_full = 2 INTEGER, PARAMETER, PUBLIC :: xalmo_case_block_diag = 0, & xalmo_case_fully_deloc = 1, & xalmo_case_normal = -1 + INTEGER, PARAMETER, PUBLIC :: xalmo_trial_simplex = 0, & + xalmo_trial_r0_out = 1 ! parameters for CT methods INTEGER, PARAMETER, PUBLIC :: tensor_orthogonal = 1, & @@ -919,6 +926,11 @@ MODULE input_constants virt_occ_size = 3, & virt_number = 4 + ! spd matrix inversion algorithm + INTEGER, PARAMETER, PUBLIC :: spd_inversion_ls_hotelling = 0, & + spd_inversion_dense_cholesky = 1, & + spd_inversion_ls_taylor = 2 + ! some MP2 parameters INTEGER, PARAMETER, PUBLIC :: mp2_method_none = 0, & mp2_method_laplace = 2, & diff --git a/src/input_cp2k_almo.F b/src/input_cp2k_almo.F index 5384c4e88d..40a704c2c9 100644 --- a/src/input_cp2k_almo.F +++ b/src/input_cp2k_almo.F @@ -10,15 +10,20 @@ MODULE input_cp2k_almo USE bibliography, ONLY: Khaliullin2007,& Khaliullin2008,& - Khaliullin2013 + Khaliullin2013,& + Scheiber2018 USE cp_output_handling, ONLY: cp_print_key_section_create,& low_print_level USE input_constants, ONLY: & almo_deloc_none, almo_deloc_scf, almo_deloc_x, almo_deloc_x_then_scf, & almo_deloc_xalmo_1diag, almo_deloc_xalmo_scf, almo_deloc_xalmo_x, almo_frz_crystal, & - almo_frz_none, almo_scf_diag, almo_scf_pcg, atomic_guess, cg_dai_yuan, cg_fletcher, & - cg_fletcher_reeves, cg_hager_zhang, cg_hestenes_stiefel, cg_liu_storey, cg_polak_ribiere, & - cg_zero, molecular_guess, optimizer_diis, optimizer_pcg, prec_default, prec_zero + almo_frz_none, almo_occ_vol_penalty_lndet, almo_occ_vol_penalty_none, almo_scf_diag, & + almo_scf_pcg, almo_scf_skip, atomic_guess, cg_dai_yuan, cg_fletcher, cg_fletcher_reeves, & + cg_hager_zhang, cg_hestenes_stiefel, cg_liu_storey, cg_polak_ribiere, cg_zero, & + molecular_guess, optimizer_diis, optimizer_lin_eq_pcg, optimizer_pcg, & + spd_inversion_dense_cholesky, spd_inversion_ls_hotelling, spd_inversion_ls_taylor, & + xalmo_prec_domain, xalmo_prec_full, xalmo_prec_zero, xalmo_trial_r0_out, & + xalmo_trial_simplex USE input_keyword_types, ONLY: keyword_create,& keyword_release,& keyword_type @@ -39,6 +44,7 @@ MODULE input_cp2k_almo INTEGER, PARAMETER, PRIVATE :: optimizer_block_diagonal_diis = 1 INTEGER, PARAMETER, PRIVATE :: optimizer_block_diagonal_pcg = 2 INTEGER, PARAMETER, PRIVATE :: optimizer_xalmo_pcg = 3 + INTEGER, PARAMETER, PRIVATE :: optimizer_newton_pcg_solver = 5 PUBLIC :: create_almo_scf_section @@ -65,8 +71,8 @@ CONTAINS description="Settings for a class of efficient linear scaling methods based "// & "on absolutely localized orbitals"// & " (ALMOs). ALMO methods are currently restricted to closed-shell molecular systems.", & - n_keywords=7, n_subsections=3, repeats=.FALSE., & - citations=(/Khaliullin2013/)) + n_keywords=9, n_subsections=5, repeats=.FALSE., & + citations=(/Khaliullin2013, Scheiber2018/)) NULLIFY (keyword) @@ -89,6 +95,25 @@ CONTAINS CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) + CALL keyword_create(keyword, name="MO_OVERLAP_INV_ALG", & + description="Algorithm to invert MO overlap matrix.", & + usage="MO_OVERLAP_INV_ALG LS_HOTELLING", & + default_i_val=spd_inversion_ls_hotelling, & + enum_c_vals=s2a("LS_HOTELLING", "LS_TAYLOR", "DENSE_CHOLESKY"), & + enum_desc=s2a("Linear scaling iterative Hotelling algorithm. Fast for large sparse matrices.", & + "Linear scaling algorithm based on Taylor expansion of (A+B)^(-1).", & + "Stable but dense Cholesky algorithm. Cubically scaling."), & + enum_i_vals=(/spd_inversion_ls_hotelling, spd_inversion_ls_taylor, spd_inversion_dense_cholesky/)) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + !CALL keyword_create(keyword, name="STOP_SCF_EARLY",& + ! description="Stops SCF using EPS_ERROR_EARLY or MAX_ITER_EARLY", & + ! usage="STOP_SCF_EARLY .TRUE.", default_l_val=.FALSE.,& + ! lone_keyword_l_val=.TRUE.) + !CALL section_add_keyword(section,keyword) + !CALL keyword_release(keyword) + CALL keyword_create(keyword, name="ALMO_EXTRAPOLATION_ORDER", & description="Number of previous states used for the ASPC extrapolation of the ALMO "// & "initial guess. 0 implies that the guess is given by ALMO_SCF_GUESS at each step.", & @@ -99,7 +124,7 @@ CONTAINS CALL keyword_create(keyword, name="XALMO_EXTRAPOLATION_ORDER", & description="Number of previous states used for the ASPC extrapolation of the initial guess "// & "for the delocalization correction.", & - usage="XALMO_EXTRAPOLATION_ORDER 1", default_i_val=3) + usage="XALMO_EXTRAPOLATION_ORDER 1", default_i_val=0) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) @@ -108,14 +133,28 @@ CONTAINS usage="ALMO_ALGORITHM DIAG", & default_i_val=almo_scf_diag, & !enum_c_vals=s2a("DIAG", "DM_SIGN","PCG"),& - enum_c_vals=s2a("DIAG", "PCG"), & + !enum_c_vals=s2a("DIAG", "PCG"), & + enum_c_vals=s2a("DIAG", "PCG", "SKIP"), & enum_desc=s2a("DIIS-accelerated diagonalization controlled by ALMO_OPTIMIZER_DIIS. "// & "Recommended for large systems containing small fragments.", & !"Update the density matrix using linear scaling routines. "//& !"Recommended if large fragments are present.",& - "Energy minimization with a PCG algorithm controlled by ALMO_OPTIMIZER_PCG."), & + "Energy minimization with a PCG algorithm controlled by ALMO_OPTIMIZER_PCG.", & + "Skip optimization of block-diagonal ALMOs."), & !enum_i_vals=(/almo_scf_diag,almo_scf_dm_sign,almo_scf_pcg/),& - enum_i_vals=(/almo_scf_diag, almo_scf_pcg/)) + enum_i_vals=(/almo_scf_diag, almo_scf_pcg, almo_scf_skip/)) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="XALMO_TRIAL_WF", & + description="Determines the form of the trial XALMOs.", & + usage="XALMO_TRIAL_WF SIMPLE", & + default_i_val=xalmo_trial_r0_out, & + enum_c_vals=s2a("SIMPLE", "PROJECT_R0_OUT"), & + enum_desc=s2a("Straightforward AO-basis expansion.", & + "Block-diagonal ALMOs plus the XALMO term projected onto the unoccupied "// & + "ALMO-subspace."), & + enum_i_vals=(/xalmo_trial_simplex, xalmo_trial_r0_out/)) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) @@ -150,6 +189,14 @@ CONTAINS CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) + CALL keyword_create(keyword, name="RETURN_ORTHOGONALIZED_MOS", & + description="Orthogonalize final ALMOs before they are returned"// & + "to Quickstep (i.e. for calculation of properties)", & + usage="RETURN_ORTHOGONALIZED_MOS .TRUE.", default_l_val=.TRUE., & + lone_keyword_l_val=.TRUE.) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + !CALL keyword_create(keyword, name="DELOCALIZE_EPS_ITER",& ! description="Obsolete and to be deleted: use EPS_ERROR in XALMO_OPTIMIZER_PCG",& ! usage="DELOCALIZE_EPS_ITER 1.e-5", default_r_val=1.e-5_dp) @@ -542,6 +589,16 @@ CONTAINS CALL section_add_subsection(section, subsection) CALL section_release(subsection) + NULLIFY (subsection) + CALL create_penalty_section(subsection) + CALL section_add_subsection(section, subsection) + CALL section_release(subsection) + + NULLIFY (subsection) + CALL create_matrix_iterate_section(subsection) + CALL section_add_subsection(section, subsection) + CALL section_release(subsection) + NULLIFY (subsection) CALL create_almo_analysis_section(subsection) CALL section_add_subsection(section, subsection) @@ -559,7 +616,7 @@ CONTAINS !> 2014.10 fully integrated [Rustam Z Khaliullin] !> \author Rustam Z Khaliullin ! ************************************************************************************************** - SUBROUTINE create_optimizer_section(section, optimizer_id) + RECURSIVE SUBROUTINE create_optimizer_section(section, optimizer_id) TYPE(section_type), POINTER :: section INTEGER, INTENT(IN) :: optimizer_id @@ -569,6 +626,7 @@ CONTAINS INTEGER :: optimizer_type TYPE(keyword_type), POINTER :: keyword + TYPE(section_type), POINTER :: subsection CPASSERT(.NOT. ASSOCIATED(section)) NULLIFY (section) @@ -578,18 +636,27 @@ CONTAINS CASE (optimizer_block_diagonal_diis) CALL section_create(section, "ALMO_OPTIMIZER_DIIS", & description="Controls the iterative DIIS-accelerated optimization of block-diagonal ALMOs.", & - n_keywords=3, n_subsections=0, repeats=.FALSE.) + n_keywords=5, n_subsections=0, repeats=.FALSE.) optimizer_type = optimizer_diis CASE (optimizer_block_diagonal_pcg) CALL section_create(section, "ALMO_OPTIMIZER_PCG", & description="Controls the PCG optimization of block-diagonal ALMOs.", & - n_keywords=6, n_subsections=0, repeats=.FALSE.) + n_keywords=9, n_subsections=0, repeats=.FALSE.) optimizer_type = optimizer_pcg CASE (optimizer_xalmo_pcg) CALL section_create(section, "XALMO_OPTIMIZER_PCG", & description="Controls the PCG optimization of extended ALMOs.", & - n_keywords=6, n_subsections=0, repeats=.FALSE.) + n_keywords=10, n_subsections=1, repeats=.FALSE.) + NULLIFY (subsection) + CALL create_optimizer_section(subsection, optimizer_newton_pcg_solver) + CALL section_add_subsection(section, subsection) + CALL section_release(subsection) optimizer_type = optimizer_pcg + CASE (optimizer_newton_pcg_solver) + CALL section_create(section, "XALMO_NEWTON_PCG_SOLVER", & + description="Controls an iterative solver of the Newton-Raphson linear equation.", & + n_keywords=4, n_subsections=0, repeats=.FALSE.) + optimizer_type = optimizer_lin_eq_pcg CASE DEFAULT CPABORT("No default values allowed") END SELECT @@ -609,6 +676,21 @@ CONTAINS CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) + ! add common keywords + CALL keyword_create(keyword, name="MAX_ITER_EARLY", & + description="Maximum number of iterations for truncated SCF "// & + "(e.g. Langevin-corrected MD). Negative values mean that this keyword is not used.", & + usage="MAX_ITER_EARLY 5", default_i_val=-1) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="EPS_ERROR_EARLY", & + description="Target value of the MAX norm of the error for truncated SCF "// & + "(e.g. Langevin-corrected MD). Negative values mean that this keyword is not used.", & + usage="EPS_ERROR_EARLY 1.E-2", default_r_val=-1.0_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + ! add keywords specific to each type SELECT CASE (optimizer_type) CASE (optimizer_diis) @@ -620,19 +702,50 @@ CONTAINS CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - CASE (optimizer_pcg) + CASE (optimizer_pcg, optimizer_lin_eq_pcg) - CALL keyword_create(keyword, name="LIN_SEARCH_EPS_ERROR", & - description="Target value of the gradient norm during the linear search", & - usage="LIN_SEARCH_EPS_ERROR 1.E-2", default_r_val=1.0E-3_dp) - CALL section_add_keyword(section, keyword) - CALL keyword_release(keyword) + IF (optimizer_type .EQ. optimizer_pcg) THEN - CALL keyword_create(keyword, name="LIN_SEARCH_STEP_SIZE_GUESS", & - description="The size of the first step in the linear search", & - usage="LIN_SEARCH_STEP_SIZE_GUESS 0.1", default_r_val=1.0_dp) - CALL section_add_keyword(section, keyword) - CALL keyword_release(keyword) + CALL keyword_create(keyword, name="LIN_SEARCH_EPS_ERROR", & + description="Target value of the gradient norm during the linear search", & + usage="LIN_SEARCH_EPS_ERROR 1.E-2", default_r_val=1.0E-3_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="LIN_SEARCH_STEP_SIZE_GUESS", & + description="The size of the first step in the linear search", & + usage="LIN_SEARCH_STEP_SIZE_GUESS 0.1", default_r_val=1.0_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="CONJUGATOR", & + description="Various methods to compute step directions in the PCG optimization", & + usage="CONJUGATOR POLAK_RIBIERE", & + default_i_val=cg_hager_zhang, & + enum_c_vals=s2a("ZERO", "POLAK_RIBIERE", "FLETCHER_REEVES", & + "HESTENES_STIEFEL", "FLETCHER", "LIU_STOREY", "DAI_YUAN", "HAGER_ZHANG"), & + enum_desc=s2a("Steepest descent", "Polak and Ribiere", & + "Fletcher and Reeves", "Hestenes and Stiefel", & + "Fletcher (Conjugate descent)", "Liu and Storey", & + "Dai and Yuan", "Hager and Zhang"), & + enum_i_vals=(/cg_zero, cg_polak_ribiere, cg_fletcher_reeves, & + cg_hestenes_stiefel, cg_fletcher, cg_liu_storey, & + cg_dai_yuan, cg_hager_zhang/)) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="PRECOND_FILTER_THRESHOLD", & + description="Select eigenvalues of the preconditioner "// & + "that are smaller than the threshold and project out the "// & + "corresponding eigenvectors from the gradient. No matter "// & + "how large the threshold is the maximum number of projected "// & + "eienvectors for a fragment equals to the number of occupied "// & + "orbitals of fragment's neighbors.", & + usage="PRECOND_FILTER_THRESHOLD 0.1", default_r_val=0.5_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + ENDIF CALL keyword_create(keyword, name="MAX_ITER_OUTER_LOOP", & description="Maximum number of iterations in the outer loop. "// & @@ -644,27 +757,16 @@ CONTAINS CALL keyword_create(keyword, name="PRECONDITIONER", & description="Select a preconditioner for the conjugate gradient optimization", & - usage="PRECONDITIONER NONE", & - default_i_val=-1, & - enum_c_vals=s2a("DEFAULT", "NONE"), & - enum_desc=s2a("Default preconditioner", "Do not use preconditioner"), & - enum_i_vals=(/prec_default, prec_zero/)) - CALL section_add_keyword(section, keyword) - CALL keyword_release(keyword) - - CALL keyword_create(keyword, name="CONJUGATOR", & - description="Various methods to compute step directions in the PCG optimization", & - usage="CONJUGATOR POLAK_RIBIERE", & - default_i_val=cg_hager_zhang, & - enum_c_vals=s2a("ZERO", "POLAK_RIBIERE", "FLETCHER_REEVES", & - "HESTENES_STIEFEL", "FLETCHER", "LIU_STOREY", "DAI_YUAN", "HAGER_ZHANG"), & - enum_desc=s2a("Steepest descent", "Polak and Ribiere", & - "Fletcher and Reeves", "Hestenes and Stiefel", & - "Fletcher (Conjugate descent)", "Liu and Storey", & - "Dai and Yuan", "Hager and Zhang"), & - enum_i_vals=(/cg_zero, cg_polak_ribiere, cg_fletcher_reeves, & - cg_hestenes_stiefel, cg_fletcher, cg_liu_storey, & - cg_dai_yuan, cg_hager_zhang/)) + usage="PRECONDITIONER DOMAIN", & + default_i_val=1, & + enum_c_vals=s2a("NONE", "DEFAULT", "DOMAIN", "FULL"), & + enum_desc=s2a("Do not use preconditioner", & + "Same as DOMAIN preconditioner", & + "Invert preconditioner domain-by-domain."// & + " The main component of the linear scaling algorithm", & + "Solve linear equations step=-H.grad on the entire space"), & + enum_i_vals=(/xalmo_prec_zero, xalmo_prec_domain, & + xalmo_prec_domain, xalmo_prec_full/)) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) @@ -672,6 +774,98 @@ CONTAINS END SUBROUTINE create_optimizer_section +! ************************************************************************************************** +!> \brief The section controls iterative matrix operations like SQRT or inverse +!> \param section ... +!> \par History +!> 2017.05 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE create_matrix_iterate_section(section) + + TYPE(section_type), POINTER :: section + + TYPE(keyword_type), POINTER :: keyword + + CPASSERT(.NOT. ASSOCIATED(section)) + NULLIFY (section) + + CALL section_create(section, "MATRIX_ITERATE", & + description="Controls linear scaling iterative procedure on matrices: inversion, sqrti, etc. "// & + "High-order Lanczos accelerates convergence provided it can estimate the eigenspectrum correctly.", & + n_keywords=4, n_subsections=0, repeats=.FALSE.) + + NULLIFY (keyword) + + CALL keyword_create(keyword, name="EPS_TARGET_FACTOR", & + description="Multiplication factor that determines acceptable error in the iterative procedure. "// & + "Acceptable error = EPS_TARGET_FACTOR * EPS_FILTER", & + usage="EPS_TARGET_FACTOR 100.0", default_r_val=10.0_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="EPS_LANCZOS", & + description="Threshold for Lanczos eigenvalue estimation.", & + usage="EPS_LANCZOS 1.0E-4", default_r_val=1.0E-3_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="ORDER_LANCZOS", & + description="Order of the Lanczos estimator. Use 0 to turn off. Do not use 1.", & + usage="ORDER_LANCZOS 5", default_i_val=3) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="MAX_ITER_LANCZOS", & + description="Maximum number of Lanczos iterations.", & + usage="MAX_ITER_LANCZOS 64", default_i_val=128) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + END SUBROUTINE create_matrix_iterate_section + +! ************************************************************************************************** +!> \brief The section controls penalty methods +!> \param section ... +!> \par History +!> 2018.01 created [Rustam Z Khaliullin] +!> \author Rustam Z Khaliullin +! ************************************************************************************************** + SUBROUTINE create_penalty_section(section) + + TYPE(section_type), POINTER :: section + + TYPE(keyword_type), POINTER :: keyword + + CPASSERT(.NOT. ASSOCIATED(section)) + NULLIFY (section) + + CALL section_create(section, "PENALTY", & + description="Add penalty terms to the energy functional.", & + n_keywords=2, n_subsections=0, repeats=.FALSE.) + + NULLIFY (keyword) + + CALL keyword_create( & + keyword, name="OCCUPIED_VOLUME_PENALTY_METHOD", & + description="Penalty that prevents nonorthogonal orbitals from becoming linear dependent.", & + usage="OCCUPIED_VOLUME_PENALTY_METHOD LNDET", & + default_i_val=almo_occ_vol_penalty_none, & + enum_c_vals=s2a("NONE", "LNDET"), & + enum_desc=s2a("Do not use penalties", & + "Use -coeff*ln(det(MO-overlap)) term."), & + enum_i_vals=(/almo_occ_vol_penalty_none, almo_occ_vol_penalty_lndet/)) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + CALL keyword_create(keyword, name="OCCUPIED_VOLUME_PENALTY_COEFF", & + description="Multiplication factor that determines the strength of the penalty term.", & + usage="OCCUPIED_VOLUME_PENALTY_COEFF 10.0", default_r_val=1.0_dp) + CALL section_add_keyword(section, keyword) + CALL keyword_release(keyword) + + END SUBROUTINE create_penalty_section + ! ************************************************************************************************** !> \brief The section controls electronic structure analysis based on ALMOs !> \param section ... @@ -694,7 +888,7 @@ CONTAINS CALL section_create(section, "ANALYSIS", & description="Controls electronic structure analysis based on ALMOs and XALMOs.", & - n_keywords=2, n_subsections=0, repeats=.FALSE., & + n_keywords=2, n_subsections=1, repeats=.FALSE., & citations=(/Khaliullin2007, Khaliullin2008/)) NULLIFY (keyword) diff --git a/src/iterate_matrix.F b/src/iterate_matrix.F index 60da5ab01f..865d846245 100644 --- a/src/iterate_matrix.F +++ b/src/iterate_matrix.F @@ -10,20 +10,16 @@ ! ************************************************************************************************** MODULE iterate_matrix USE arnoldi_api, ONLY: arnoldi_data_type,& - arnoldi_ev,& - arnoldi_extremal,& - deallocate_arnoldi_data,& - get_selected_ritz_val,& - setup_arnoldi_data + arnoldi_extremal USE cp_log_handling, ONLY: cp_get_default_logger,& cp_logger_get_default_unit_nr,& cp_logger_type USE dbcsr_api, ONLY: & - dbcsr_add, dbcsr_add_on_diag, dbcsr_copy, dbcsr_create, dbcsr_filter, & - dbcsr_frobenius_norm, dbcsr_gershgorin_norm, dbcsr_get_info, dbcsr_get_matrix_type, & - dbcsr_get_occupation, dbcsr_multiply, dbcsr_norm, dbcsr_norm_maxabsnorm, dbcsr_p_type, & - dbcsr_release, dbcsr_scale, dbcsr_set, dbcsr_trace, dbcsr_transposed, dbcsr_type, & - dbcsr_type_no_symmetry + dbcsr_add, dbcsr_add_on_diag, dbcsr_copy, dbcsr_create, dbcsr_desymmetrize, dbcsr_filter, & + dbcsr_frobenius_norm, dbcsr_gershgorin_norm, dbcsr_get_diag, dbcsr_get_info, & + dbcsr_get_matrix_type, dbcsr_get_occupation, dbcsr_multiply, dbcsr_norm, & + dbcsr_norm_maxabsnorm, dbcsr_p_type, dbcsr_release, dbcsr_scale, dbcsr_set, & + dbcsr_set_diag, dbcsr_trace, dbcsr_transposed, dbcsr_type, dbcsr_type_no_symmetry USE kinds, ONLY: dp,& int_8 USE machine, ONLY: m_flush,& @@ -43,51 +39,246 @@ MODULE iterate_matrix END INTERFACE PUBLIC :: invert_Hotelling, matrix_sign_Newton_Schulz, matrix_sqrt_Newton_Schulz, & - purify_mcweeny + purify_mcweeny, invert_Taylor, determinant CONTAINS +! ***************************************************************************** +!> \brief Computes the determinant of a symmetric positive definite matrix +!> using the trace of the matrix logarithm via Mercator series: +!> det(A) = det(S)det(I+X)det(S), where S=diag(sqrt(Aii),..,sqrt(Ann)) +!> det(I+X) = Exp(Trace(Ln(I+X))) +!> Ln(I+X) = X - X^2/2 + X^3/3 - X^4/4 + .. +!> The series converges only if the Frobenius norm of X is less than 1. +!> If it is more than one we compute (recursevily) the determinant of +!> the square root of (I+X). +!> \param matrix ... +!> \param det - determinant +!> \param threshold ... +!> \par History +!> 2015.04 created [Rustam Z Khaliullin] +!> \author Rustam Z. Khaliullin ! ************************************************************************************************** -!> \brief invert a symmetric positive definite matrix by Hotelling's method -!> explicit symmetrization makes this code not suitable for other matrix types -!> Currently a bit messy with the options, to to be cleaned soon + RECURSIVE SUBROUTINE determinant(matrix, det, threshold) + + TYPE(dbcsr_type), INTENT(INOUT) :: matrix + REAL(KIND=dp), INTENT(INOUT) :: det + REAL(KIND=dp), INTENT(IN) :: threshold + + CHARACTER(LEN=*), PARAMETER :: routineN = 'determinant', routineP = moduleN//':'//routineN + + INTEGER :: handle, i, max_iter_lanczos, nsize, & + order_lanczos, sign_iter, unit_nr + INTEGER(KIND=int_8) :: flop1, flop2 + INTEGER, SAVE :: recursion_depth = 0 + REAL(KIND=dp) :: det0, eps_lanczos, frobnorm, maxnorm, & + occ_matrix, t1, t2, trace + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: diagonal + TYPE(cp_logger_type), POINTER :: logger + TYPE(dbcsr_type) :: tmp1, tmp2, tmp3 + + CALL timeset(routineN, handle) + + ! get a useful output_unit + logger => cp_get_default_logger() + IF (logger%para_env%mepos == logger%para_env%source) THEN + unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.) + ELSE + unit_nr = -1 + ENDIF + + ! Note: tmp1 and tmp2 have the same matrix type as the + ! initial matrix (tmp3 does not have symmetry constraints) + ! this might lead to uninteded results with anti-symmetric + ! matrices + CALL dbcsr_create(tmp1, template=matrix, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(tmp2, template=matrix, & + matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(tmp3, template=matrix, & + matrix_type=dbcsr_type_no_symmetry) + + ! compute the product of the diagonal elements + CALL dbcsr_get_info(matrix, nfullrows_total=nsize) + ALLOCATE (diagonal(nsize)) + CALL dbcsr_get_diag(matrix, diagonal) + det = PRODUCT(diagonal) + + ! create diagonal SQRTI matrix + diagonal(:) = 1.0_dp/(SQRT(diagonal(:))) + !ROLL CALL dbcsr_copy(tmp1,matrix) + CALL dbcsr_desymmetrize(matrix, tmp1) + CALL dbcsr_set(tmp1, 0.0_dp) + CALL dbcsr_set_diag(tmp1, diagonal) + CALL dbcsr_filter(tmp1, threshold) + DEALLOCATE (diagonal) + + ! normalize the main diagonal, off-diagonal elements are scaled to + ! make the norm of the matrix less than 1 + CALL dbcsr_multiply("N", "N", 1.0_dp, & + matrix, & + tmp1, & + 0.0_dp, tmp3, & + filter_eps=threshold) + CALL dbcsr_multiply("N", "N", 1.0_dp, & + tmp1, & + tmp3, & + 0.0_dp, tmp2, & + filter_eps=threshold) + + ! subtract the main diagonal to create matrix X + CALL dbcsr_add_on_diag(tmp2, -1.0_dp) + frobnorm = dbcsr_frobenius_norm(tmp2) + IF (unit_nr > 0) THEN + IF (recursion_depth .EQ. 0) THEN + WRITE (unit_nr, '()') + ELSE + WRITE (unit_nr, '(T6,A28,1X,I15)') & + "Recursive iteration:", recursion_depth + ENDIF + WRITE (unit_nr, '(T6,A28,1X,F15.10)') & + "Frobenius norm:", frobnorm + CALL m_flush(unit_nr) + ENDIF + + IF (frobnorm .GE. 1.0_dp) THEN + + CALL dbcsr_add_on_diag(tmp2, 1.0_dp) + ! these controls should be provided as input + order_lanczos = 3 + eps_lanczos = 1.0E-4_dp + max_iter_lanczos = 40 + CALL matrix_sqrt_Newton_Schulz( & + tmp3, & ! output sqrt + tmp1, & ! output sqrti + tmp2, & ! input original + threshold=threshold, & + order=order_lanczos, & + eps_lanczos=eps_lanczos, & + max_iter_lanczos=max_iter_lanczos) + recursion_depth = recursion_depth+1 + CALL determinant(tmp3, det0, threshold) + recursion_depth = recursion_depth-1 + det = det*det0*det0 + + ELSE + + ! create accumulator + CALL dbcsr_copy(tmp1, tmp2) + ! re-create to make use of symmetry + !ROLL CALL dbcsr_create(tmp3,template=matrix) + + IF (unit_nr > 0) WRITE (unit_nr, *) + + ! initialize the sign of the term + sign_iter = -1 + DO i = 1, 100 + + t1 = m_walltime() + + ! multiply X^i by X + ! note that the first iteration evaluates X^2 + ! because the trace of X^1 is zero by construction + CALL dbcsr_multiply("N", "N", 1.0_dp, tmp1, tmp2, & + 0.0_dp, tmp3, & + filter_eps=threshold, & + flop=flop1) + CALL dbcsr_copy(tmp1, tmp3) + + ! get trace + CALL dbcsr_trace(tmp1, trace) + trace = trace*sign_iter/(1.0_dp*(i+1)) + sign_iter = -sign_iter + + ! update the determinant + det = det*EXP(trace) + + occ_matrix = dbcsr_get_occupation(tmp1) + CALL dbcsr_norm(tmp1, & + dbcsr_norm_maxabsnorm, norm_scalar=maxnorm) + + t2 = m_walltime() + + IF (unit_nr > 0) THEN + WRITE (unit_nr, '(T6,A,1X,I3,1X,F7.5,F16.10,F10.3,F11.3)') & + "Determinant iter", i, occ_matrix, & + det, t2-t1, & + (flop1+flop2)/(1.0E6_dp*MAX(0.001_dp, t2-t1)) + CALL m_flush(unit_nr) + ENDIF + + ! exit if the trace is close to zero + IF (maxnorm < threshold) EXIT + + ENDDO ! end iterations + + IF (unit_nr > 0) THEN + WRITE (unit_nr, '()') + CALL m_flush(unit_nr) + ENDIF + + ENDIF ! decide to do sqrt or not + + IF (unit_nr > 0) THEN + IF (recursion_depth .EQ. 0) THEN + WRITE (unit_nr, '(T6,A28,1X,F15.10)') & + "Final determinant:", det + WRITE (unit_nr, '()') + ELSE + WRITE (unit_nr, '(T6,A28,1X,F15.10)') & + "Recursive determinant:", det + ENDIF + CALL m_flush(unit_nr) + ENDIF + + CALL dbcsr_release(tmp1) + CALL dbcsr_release(tmp2) + CALL dbcsr_release(tmp3) + + CALL timestop(handle) + + END SUBROUTINE determinant + +! ************************************************************************************************** +!> \brief invert a symmetric positive definite diagonally dominant matrix !> \param matrix_inverse ... !> \param matrix ... !> \param threshold convergence threshold nased on the max abs !> \param use_inv_as_guess logical whether input can be used as guess for inverse !> \param norm_convergence convergence threshold for the 2-norm, useful for approximate solutions !> \param filter_eps filter_eps for matrix multiplications, if not passed nothing is filteres +!> \param accelerator_order ... +!> \param max_iter_lanczos ... +!> \param eps_lanczos ... !> \param silent ... !> \par History !> 2010.10 created [Joost VandeVondele] !> 2011.10 guess option added [Rustam Z Khaliullin] !> \author Joost VandeVondele ! ************************************************************************************************** - SUBROUTINE invert_Hotelling(matrix_inverse, matrix, threshold, use_inv_as_guess, & - norm_convergence, filter_eps, silent) + SUBROUTINE invert_Taylor(matrix_inverse, matrix, threshold, use_inv_as_guess, & + norm_convergence, filter_eps, accelerator_order, & + max_iter_lanczos, eps_lanczos, silent) TYPE(dbcsr_type), INTENT(INOUT), TARGET :: matrix_inverse, matrix REAL(KIND=dp), INTENT(IN) :: threshold LOGICAL, INTENT(IN), OPTIONAL :: use_inv_as_guess REAL(KIND=dp), INTENT(IN), OPTIONAL :: norm_convergence, filter_eps + INTEGER, INTENT(IN), OPTIONAL :: accelerator_order, max_iter_lanczos + REAL(KIND=dp), INTENT(IN), OPTIONAL :: eps_lanczos LOGICAL, INTENT(IN), OPTIONAL :: silent - CHARACTER(LEN=*), PARAMETER :: routineN = 'invert_Hotelling', & - routineP = moduleN//':'//routineN + CHARACTER(LEN=*), PARAMETER :: routineN = 'invert_Taylor', routineP = moduleN//':'//routineN - INTEGER :: handle, i, nrow, unit_nr - INTEGER(KIND=int_8) :: flop1, flop2 - LOGICAL :: use_inv_guess - REAL(KIND=dp) :: convergence, frob_matrix, & - gershgorin_norm, max_ev, & - maxnorm_matrix, min_ev, occ_matrix, & - t1, t2 - TYPE(arnoldi_data_type) :: my_arnoldi + INTEGER :: accelerator_type, handle, i, & + my_max_iter_lanczos, nrows, unit_nr + INTEGER(KIND=int_8) :: flop2 + LOGICAL :: converged, use_inv_guess + REAL(KIND=dp) :: coeff, convergence, maxnorm_matrix, & + my_eps_lanczos, occ_matrix, t1, t2 + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: p_diagonal TYPE(cp_logger_type), POINTER :: logger - TYPE(dbcsr_p_type), DIMENSION(1) :: mymat - TYPE(dbcsr_type), TARGET :: tmp1, tmp2 - -! turn this off for the time being + TYPE(dbcsr_type), TARGET :: tmp1, tmp2, tmp3_sym CALL timeset(routineN, handle) @@ -104,73 +295,301 @@ CONTAINS convergence = threshold IF (PRESENT(norm_convergence)) convergence = norm_convergence + accelerator_type = 0 + IF (PRESENT(accelerator_order)) accelerator_type = accelerator_order + IF (accelerator_type .GT. 1) accelerator_type = 1 + use_inv_guess = .FALSE. IF (PRESENT(use_inv_as_guess)) use_inv_guess = use_inv_as_guess + + my_max_iter_lanczos = 64 + my_eps_lanczos = 1.0E-3_dp + IF (PRESENT(max_iter_lanczos)) my_max_iter_lanczos = max_iter_lanczos + IF (PRESENT(eps_lanczos)) my_eps_lanczos = eps_lanczos + + CALL dbcsr_create(tmp1, template=matrix_inverse, matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(tmp2, template=matrix_inverse, matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_create(tmp3_sym, template=matrix_inverse) + + CALL dbcsr_get_info(matrix, nfullrows_total=nrows) + ALLOCATE (p_diagonal(nrows)) + + ! generate the initial guess IF (.NOT. use_inv_guess) THEN - ! initialize matrix to unity and use arnoldi to scale it into the convergence range - gershgorin_norm = dbcsr_gershgorin_norm(matrix) - frob_matrix = dbcsr_frobenius_norm(matrix) - CALL dbcsr_set(matrix_inverse, 0.0_dp) - CALL dbcsr_add_on_diag(matrix_inverse, 1.0_dp) - ! everything commutes, therefor our all products will be symmetric - CALL dbcsr_create(tmp1, template=matrix_inverse) + + SELECT CASE (accelerator_type) + CASE (0) + ! use tmp1 to hold off-diagonal elements + CALL dbcsr_desymmetrize(matrix, tmp1) + p_diagonal(:) = 0.0_dp + CALL dbcsr_set_diag(tmp1, p_diagonal) + !CALL dbcsr_print(tmp1) + ! invert the main diagonal + CALL dbcsr_get_diag(matrix, p_diagonal) + p_diagonal(:) = 1.0_dp/p_diagonal(:) + CALL dbcsr_set(matrix_inverse, 0.0_dp) + CALL dbcsr_add_on_diag(matrix_inverse, 1.0_dp) + CALL dbcsr_set_diag(matrix_inverse, p_diagonal) + CASE DEFAULT + CPABORT("Illegal accelerator order") + END SELECT + ELSE + + CPABORT("Guess is NYI") + + ENDIF + + CALL dbcsr_multiply("N", "N", 1.0_dp, tmp1, matrix_inverse, & + 0.0_dp, tmp2, filter_eps=filter_eps) + + IF (unit_nr > 0) WRITE (unit_nr, *) + + ! scale the approximate inverse to be within the convergence radius + t1 = m_walltime() + + ! done with the initial guess, start iterations + converged = .FALSE. + CALL dbcsr_desymmetrize(matrix_inverse, tmp1) + coeff = 1.0_dp + DO i = 1, 100 + + ! coeff = +/- 1 + coeff = -1.0_dp*coeff + CALL dbcsr_multiply("N", "N", 1.0_dp, tmp1, tmp2, 0.0_dp, & + tmp3_sym, & + flop=flop2, filter_eps=filter_eps) + !flop=flop2) + CALL dbcsr_add(matrix_inverse, tmp3_sym, 1.0_dp, coeff) + CALL dbcsr_release(tmp1) + CALL dbcsr_create(tmp1, template=matrix_inverse, matrix_type=dbcsr_type_no_symmetry) + CALL dbcsr_desymmetrize(tmp3_sym, tmp1) + + ! for the convergence check + CALL dbcsr_norm(tmp3_sym, & + dbcsr_norm_maxabsnorm, norm_scalar=maxnorm_matrix) + + t2 = m_walltime() + occ_matrix = dbcsr_get_occupation(matrix_inverse) + + IF (unit_nr > 0) THEN + WRITE (unit_nr, '(T6,A,1X,I3,1X,F10.8,E12.3,F12.3,F13.3)') "Taylor iter", i, occ_matrix, & + maxnorm_matrix, t2-t1, & + flop2/(1.0E6_dp*MAX(0.001_dp, t2-t1)) + CALL m_flush(unit_nr) + ENDIF + + IF (maxnorm_matrix < convergence) THEN + converged = .TRUE. + EXIT + ENDIF + + t1 = m_walltime() + + ENDDO + + !last convergence check + CALL dbcsr_multiply("N", "N", 1.0_dp, matrix, matrix_inverse, 0.0_dp, tmp1, & + filter_eps=filter_eps) + CALL dbcsr_add_on_diag(tmp1, -1.0_dp) + !frob_matrix = dbcsr_frobenius_norm(tmp1) + CALL dbcsr_norm(tmp1, dbcsr_norm_maxabsnorm, norm_scalar=maxnorm_matrix) + IF (unit_nr > 0) THEN + WRITE (unit_nr, '(T6,A,E12.5)') "Final Taylor error", maxnorm_matrix + WRITE (unit_nr, '()') + CALL m_flush(unit_nr) + ENDIF + IF (maxnorm_matrix > convergence) THEN + converged = .FALSE. + IF (unit_nr > 0) THEN + WRITE (*, *) 'Final convergence check failed' + ENDIF + ENDIF + + IF (.NOT. converged) THEN + CPABORT("Taylor inversion did not converge") + ENDIF + + CALL dbcsr_release(tmp1) + CALL dbcsr_release(tmp2) + CALL dbcsr_release(tmp3_sym) + + DEALLOCATE (p_diagonal) + + CALL timestop(handle) + + END SUBROUTINE invert_Taylor + +! ************************************************************************************************** +!> \brief invert a symmetric positive definite matrix by Hotelling's method +!> explicit symmetrization makes this code not suitable for other matrix types +!> Currently a bit messy with the options, to to be cleaned soon +!> \param matrix_inverse ... +!> \param matrix ... +!> \param threshold convergence threshold nased on the max abs +!> \param use_inv_as_guess logical whether input can be used as guess for inverse +!> \param norm_convergence convergence threshold for the 2-norm, useful for approximate solutions +!> \param filter_eps filter_eps for matrix multiplications, if not passed nothing is filteres +!> \param accelerator_order ... +!> \param max_iter_lanczos ... +!> \param eps_lanczos ... +!> \param silent ... +!> \par History +!> 2010.10 created [Joost VandeVondele] +!> 2011.10 guess option added [Rustam Z Khaliullin] +!> \author Joost VandeVondele +! ************************************************************************************************** + SUBROUTINE invert_Hotelling(matrix_inverse, matrix, threshold, use_inv_as_guess, & + norm_convergence, filter_eps, accelerator_order, & + max_iter_lanczos, eps_lanczos, silent) + + TYPE(dbcsr_type), INTENT(INOUT), TARGET :: matrix_inverse, matrix + REAL(KIND=dp), INTENT(IN) :: threshold + LOGICAL, INTENT(IN), OPTIONAL :: use_inv_as_guess + REAL(KIND=dp), INTENT(IN), OPTIONAL :: norm_convergence, filter_eps + INTEGER, INTENT(IN), OPTIONAL :: accelerator_order, max_iter_lanczos + REAL(KIND=dp), INTENT(IN), OPTIONAL :: eps_lanczos + LOGICAL, INTENT(IN), OPTIONAL :: silent + + CHARACTER(LEN=*), PARAMETER :: routineN = 'invert_Hotelling', & + routineP = moduleN//':'//routineN + + INTEGER :: accelerator_type, handle, i, & + my_max_iter_lanczos, unit_nr + INTEGER(KIND=int_8) :: flop1, flop2 + LOGICAL :: arnoldi_converged, converged, & + use_inv_guess + REAL(KIND=dp) :: convergence, frob_matrix, gershgorin_norm, max_ev, maxnorm_matrix, min_ev, & + my_eps_lanczos, my_filter_eps, occ_matrix, scalingf, t1, t2 + TYPE(cp_logger_type), POINTER :: logger + TYPE(dbcsr_type), TARGET :: tmp1, tmp2 + + !TYPE(arnoldi_data_type) :: my_arnoldi + !TYPE(dbcsr_p_type), DIMENSION(1) :: mymat + + CALL timeset(routineN, handle) + + logger => cp_get_default_logger() + IF (logger%para_env%mepos == logger%para_env%source) THEN + unit_nr = cp_logger_get_default_unit_nr(logger, local=.TRUE.) + ELSE + unit_nr = -1 + ENDIF + IF (PRESENT(silent)) THEN + IF (silent) unit_nr = -1 + END IF + + convergence = threshold + IF (PRESENT(norm_convergence)) convergence = norm_convergence + + accelerator_type = 1 + IF (PRESENT(accelerator_order)) accelerator_type = accelerator_order + IF (accelerator_type .GT. 1) accelerator_type = 1 + + use_inv_guess = .FALSE. + IF (PRESENT(use_inv_as_guess)) use_inv_guess = use_inv_as_guess + + my_max_iter_lanczos = 64 + my_eps_lanczos = 1.0E-3_dp + IF (PRESENT(max_iter_lanczos)) my_max_iter_lanczos = max_iter_lanczos + IF (PRESENT(eps_lanczos)) my_eps_lanczos = eps_lanczos + + my_filter_eps = threshold + IF (PRESENT(filter_eps)) my_filter_eps = filter_eps + + ! generate the initial guess + IF (.NOT. use_inv_guess) THEN + + SELECT CASE (accelerator_type) + CASE (0) + gershgorin_norm = dbcsr_gershgorin_norm(matrix) + frob_matrix = dbcsr_frobenius_norm(matrix) + CALL dbcsr_set(matrix_inverse, 0.0_dp) + CALL dbcsr_add_on_diag(matrix_inverse, 1/MIN(gershgorin_norm, frob_matrix)) + CASE (1) + ! initialize matrix to unity and use arnoldi (below) to scale it into the convergence range + CALL dbcsr_set(matrix_inverse, 0.0_dp) + CALL dbcsr_add_on_diag(matrix_inverse, 1.0_dp) + CASE DEFAULT + CPABORT("Illegal accelerator order") + END SELECT + + ! everything commutes, therefore our all products will be symmetric + CALL dbcsr_create(tmp1, template=matrix_inverse) + + ELSE + ! It is unlikely that our guess will commute with the matrix, therefore the first product will ! be non symmetric CALL dbcsr_create(tmp1, template=matrix_inverse, matrix_type=dbcsr_type_no_symmetry) + ENDIF - CALL dbcsr_get_info(matrix, nfullrows_total=nrow) CALL dbcsr_create(tmp2, template=matrix_inverse) IF (unit_nr > 0) WRITE (unit_nr, *) ! scale the approximate inverse to be within the convergence radius t1 = m_walltime() + CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_inverse, matrix, & - 0.0_dp, tmp1, flop=flop1, filter_eps=filter_eps) + 0.0_dp, tmp1, flop=flop1, filter_eps=my_filter_eps) - mymat(1)%matrix => tmp1 - CALL setup_arnoldi_data(my_arnoldi, mymat, max_iter=30, threshold=1.0E-3_dp, selection_crit=1, & - nval_request=2, nrestarts=2, generalized_ev=.FALSE., iram=.TRUE.) - CALL arnoldi_ev(mymat, my_arnoldi) - max_eV = REAL(get_selected_ritz_val(my_arnoldi, 2), dp) - min_eV = REAL(get_selected_ritz_val(my_arnoldi, 1), dp) - CALL deallocate_arnoldi_data(my_arnoldi) + IF (accelerator_type == 1) THEN - occ_matrix = dbcsr_get_occupation(matrix_inverse) - ! 2.0 would be the correct scaling howver, we should make sure here, that we are in the convergence radius - CALL dbcsr_scale(tmp1, 1.9_dp/(min_ev+max_ev)) - CALL dbcsr_scale(matrix_inverse, 1.9_dp/(min_ev+max_ev)) - min_ev = min_ev*1.9_dp/(min_ev+max_ev) + ! scale the matrix to get into the convergence range + CALL arnoldi_extremal(tmp1, max_eV, min_eV, threshold=my_eps_lanczos, & + max_iter=my_max_iter_lanczos, converged=arnoldi_converged) + !mymat(1)%matrix => tmp1 + !CALL setup_arnoldi_data(my_arnoldi, mymat, max_iter=30, threshold=1.0E-3_dp, selection_crit=1, & + ! nval_request=2, nrestarts=2, generalized_ev=.FALSE., iram=.TRUE.) + !CALL arnoldi_ev(mymat, my_arnoldi) + !max_eV = REAL(get_selected_ritz_val(my_arnoldi, 2), dp) + !min_eV = REAL(get_selected_ritz_val(my_arnoldi, 1), dp) + !CALL deallocate_arnoldi_data(my_arnoldi) + IF (unit_nr > 0) THEN + WRITE (unit_nr, *) + WRITE (unit_nr, '(T6,A,1X,L1,A,E12.3)') "Lanczos converged: ", arnoldi_converged, " threshold:", my_eps_lanczos + WRITE (unit_nr, '(T6,A,1X,E12.3,E12.3)') "Est. extremal eigenvalues:", max_eV, min_eV + WRITE (unit_nr, '(T6,A,1X,E12.3)') "Est. condition number :", max_eV/MAX(min_eV, EPSILON(min_eV)) + ENDIF + + ! 2.0 would be the correct scaling however, we should make sure here, that we are in the convergence radius + scalingf = 1.9_dp/(max_eV+min_eV) + CALL dbcsr_scale(tmp1, scalingf) + CALL dbcsr_scale(matrix_inverse, scalingf) + min_ev = min_ev*scalingf + + ENDIF + + ! done with the initial guess, start iterations + converged = .FALSE. DO i = 1, 100 ! tmp1 = S^-1 S ! for the convergence check - !frob_matrix_base=dbcsr_frobenius_norm(tmp1) CALL dbcsr_add_on_diag(tmp1, -1.0_dp) - frob_matrix = dbcsr_frobenius_norm(tmp1) - CALL dbcsr_norm(tmp1, & dbcsr_norm_maxabsnorm, norm_scalar=maxnorm_matrix) - CALL dbcsr_add_on_diag(tmp1, +1.0_dp) ! tmp2 = S^-1 S S^-1 CALL dbcsr_multiply("N", "N", 1.0_dp, tmp1, matrix_inverse, 0.0_dp, tmp2, & - flop=flop2, filter_eps=filter_eps) + flop=flop2, filter_eps=my_filter_eps) ! S^-1_{n+1} = 2 S^-1 - S^-1 S S^-1 CALL dbcsr_add(matrix_inverse, tmp2, 2.0_dp, -1.0_dp) - CALL dbcsr_filter(matrix_inverse, threshold) + CALL dbcsr_filter(matrix_inverse, my_filter_eps) t2 = m_walltime() occ_matrix = dbcsr_get_occupation(matrix_inverse) ! use the scalar form of the algorithm to trace the EV - min_ev = min_ev*(2.0_dp-min_ev) - IF (PRESENT(norm_convergence)) maxnorm_matrix = ABS(min_eV-1.0_dp) + IF (accelerator_type == 1) THEN + min_ev = min_ev*(2.0_dp-min_ev) + IF (PRESENT(norm_convergence)) maxnorm_matrix = ABS(min_eV-1.0_dp) + ENDIF IF (unit_nr > 0) THEN WRITE (unit_nr, '(T6,A,1X,I3,1X,F10.8,E12.3,F12.3,F13.3)') "Hotelling iter", i, occ_matrix, & @@ -179,18 +598,27 @@ CONTAINS CALL m_flush(unit_nr) ENDIF - IF (maxnorm_matrix < convergence) EXIT + IF (maxnorm_matrix < convergence) THEN + converged = .TRUE. + EXIT + ENDIF ! scale the matrix for improved convergence - min_ev = min_ev*2.0_dp/(min_ev+1.0_dp) - CALL dbcsr_scale(matrix_inverse, 2.0_dp/(min_ev+1.0_dp)) + IF (accelerator_type == 1) THEN + min_ev = min_ev*2.0_dp/(min_ev+1.0_dp) + CALL dbcsr_scale(matrix_inverse, 2.0_dp/(min_ev+1.0_dp)) + ENDIF t1 = m_walltime() CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_inverse, matrix, & - 0.0_dp, tmp1, flop=flop1, filter_eps=filter_eps) + 0.0_dp, tmp1, flop=flop1, filter_eps=my_filter_eps) ENDDO + IF (.NOT. converged) THEN + CPABORT("Hotelling inversion did not converge") + ENDIF + ! try to symmetrize the output matrix IF (dbcsr_get_matrix_type(matrix_inverse) == dbcsr_type_no_symmetry) THEN CALL dbcsr_transposed(tmp2, matrix_inverse) @@ -349,8 +777,9 @@ CONTAINS INTEGER(KIND=int_8) :: flop1, flop2, flop3, flop4, flop5 LOGICAL :: arnoldi_converged REAL(KIND=dp) :: a, b, c, conv, d, frob_matrix, & - frob_matrix_base, max_ev, min_ev, oa, & - ob, oc, occ_matrix, od, scaling, t1, t2 + frob_matrix_base, gershgorin_norm, & + max_ev, min_ev, oa, ob, oc, & + occ_matrix, od, scaling, t1, t2 TYPE(cp_logger_type), POINTER :: logger TYPE(dbcsr_type) :: tmp1, tmp2, tmp3 @@ -378,17 +807,28 @@ CONTAINS CALL dbcsr_copy(matrix_sqrt, matrix) ! scale the matrix to get into the convergence range - CALL arnoldi_extremal(matrix_sqrt, max_ev, min_ev, threshold=eps_lanczos, & - max_iter=max_iter_lanczos, converged=arnoldi_converged) - IF (unit_nr > 0) THEN - WRITE (unit_nr, *) - WRITE (unit_nr, '(T6,A,1X,L1,A,E12.3)') "Lanczos converged: ", arnoldi_converged, " threshold:", eps_lanczos - WRITE (unit_nr, '(T6,A,1X,E12.3,E12.3)') "Est. extremal eigenvalues:", max_ev, min_ev - WRITE (unit_nr, '(T6,A,1X,E12.3)') "Est. condition number :", max_ev/MAX(min_ev, EPSILON(min_ev)) + IF (order == 0) THEN + + gershgorin_norm = dbcsr_gershgorin_norm(matrix_sqrt) + frob_matrix = dbcsr_frobenius_norm(matrix_sqrt) + scaling = 1.0_dp/MIN(frob_matrix, gershgorin_norm) + + ELSE + + ! scale the matrix to get into the convergence range + CALL arnoldi_extremal(matrix_sqrt, max_ev, min_ev, threshold=eps_lanczos, & + max_iter=max_iter_lanczos, converged=arnoldi_converged) + IF (unit_nr > 0) THEN + WRITE (unit_nr, *) + WRITE (unit_nr, '(T6,A,1X,L1,A,E12.3)') "Lanczos converged: ", arnoldi_converged, " threshold:", eps_lanczos + WRITE (unit_nr, '(T6,A,1X,E12.3,E12.3)') "Est. extremal eigenvalues:", max_ev, min_ev + WRITE (unit_nr, '(T6,A,1X,E12.3)') "Est. condition number :", max_ev/MAX(min_ev, EPSILON(min_ev)) + ENDIF + ! conservatively assume we get a relatively large error (100*threshold_lanczos) in the estimates + ! and adjust the scaling to be on the safe side + scaling = 2.0_dp/(max_ev+min_ev+100*eps_lanczos) + ENDIF - ! conservatively assume we get a relatively large error (100*threshold_lanczos) in the estimates - ! and adjust the scaling to be on the safe side - scaling = 2/(max_ev+min_ev+100*eps_lanczos) CALL dbcsr_scale(matrix_sqrt, scaling) CALL dbcsr_filter(matrix_sqrt, threshold) @@ -408,7 +848,7 @@ CONTAINS flop4 = 0; flop5 = 0 SELECT CASE (order) - CASE (2) + CASE (0, 2) ! update the above to 0.5*(3*I-Zk*Yk) CALL dbcsr_add_on_diag(tmp1, -2.0_dp) CALL dbcsr_scale(tmp1, -0.5_dp) @@ -465,7 +905,7 @@ CONTAINS ! final scale CALL dbcsr_scale(tmp1, 35.0_dp/128.0_dp) CASE DEFAULT - CPABORT("") + CPABORT("Illegal order value") END SELECT ! tmp2 = Yk * tmp1 = Y(k+1) diff --git a/src/motion/integrator.F b/src/motion/integrator.F index a51e5176c0..62e1d1e3b3 100644 --- a/src/motion/integrator.F +++ b/src/motion/integrator.F @@ -215,6 +215,9 @@ CONTAINS ! atoms because of the possiblity of Langevin regions, and var_w ! for each region should depend on the temperature defined in the ! region + ! RZK explains: sigma is the variance of the Wiener process associated + ! with the stochastic term, sigma = m*var_w = m*(2*k_B*T*gamma*dt), + ! noisy_gamma adds excessive noise that is not balanced by the damping term ALLOCATE(var_w(nparticle)) var_w(1:nparticle) = simpar%var_w IF (simpar%do_thermal_region) THEN diff --git a/src/mscfg_methods.F b/src/mscfg_methods.F index 2ae995821a..937bfc8458 100644 --- a/src/mscfg_methods.F +++ b/src/mscfg_methods.F @@ -374,7 +374,7 @@ CONTAINS INTEGER :: almo_guess_type, frz_term_type, & method_name_id, scf_guess_type - LOGICAL :: is_crystal, is_fast_dirty + LOGICAL :: almo_scf_is_on, is_crystal, is_fast_dirty TYPE(molecular_scf_guess_env_type), POINTER :: mscfg_env TYPE(qs_environment_type), POINTER :: qs_env TYPE(section_vals_type), POINTER :: force_env_section, subsection @@ -383,6 +383,7 @@ CONTAINS ! What kind of options are we using in the loop ? is_fast_dirty = .TRUE. is_crystal = .FALSE. + almo_scf_is_on = .FALSE. NULLIFY (qs_env, mscfg_env, force_env_section, subsection) CALL force_env_get(force_env, force_env_section=force_env_section) @@ -405,6 +406,10 @@ CONTAINS NULLIFY (subsection) subsection => section_vals_get_subs_vals(force_env_section, "DFT%ALMO_SCF") CALL section_vals_val_get(subsection, "ALMO_SCF_GUESS", i_val=almo_guess_type) + ! check whether ALMO SCF is on + NULLIFY (subsection) + subsection => section_vals_get_subs_vals(force_env_section, "DFT%QS") + CALL section_vals_val_get(subsection, "ALMO_SCF", l_val=almo_scf_is_on) ! check SCF guess option NULLIFY (subsection) @@ -419,7 +424,7 @@ CONTAINS ! Are we doing the loop ? IF (scf_guess_type .EQ. molecular_guess .OR. & ! SCF guess is molecular - almo_guess_type .EQ. molecular_guess .OR. & ! ALMO SCF guess is molecular + (almo_guess_type .EQ. molecular_guess .AND. almo_scf_is_on) .OR. & ! ALMO SCF guess is molecular frz_term_type .NE. almo_frz_none) THEN ! ALMO FRZ term is requested do_mol_loop = .TRUE. diff --git a/src/optimize_basis.F b/src/optimize_basis.F index 3adc0199a1..46539e1360 100644 --- a/src/optimize_basis.F +++ b/src/optimize_basis.F @@ -289,14 +289,17 @@ CONTAINS qs_env%admm_env%work_aux_aux, energy(my_id)) my_time(my_id) = m_walltime()-start_time(icalc) - IF (.NOT. para_env%ionode) THEN - f_vec = 0.0_dp; cond_vec = 0.0_dp; my_time = 0.0_dp; energy = 0.0_dp - END IF END DO + IF (.NOT. para_env%ionode) THEN + f_vec = 0.0_dp; cond_vec = 0.0_dp; my_time = 0.0_dp; energy = 0.0_dp + END IF DEALLOCATE (start_time) - CALL mp_sum(f_vec, para_env_top%group); CALL mp_sum(cond_vec, para_env_top%group); CALL mp_sum(my_time, para_env_top%group) + CALL mp_sum(f_vec, para_env_top%group) + CALL mp_sum(cond_vec, para_env_top%group) + CALL mp_sum(my_time, para_env_top%group) + CALL mp_sum(energy, para_env_top%group) opt_bas%powell_param%f = 0.0_dp DO icalc = 1, SIZE(f_vec) icomb = MOD(icalc-1, opt_bas%ncombinations) diff --git a/src/qs_force.F b/src/qs_force.F index 89f94fbfc5..2a8e605b5f 100644 --- a/src/qs_force.F +++ b/src/qs_force.F @@ -310,22 +310,6 @@ CONTAINS ! Compute grid-based forces CALL qs_ks_update_qs_env(qs_env, calculate_forces=.TRUE.) - ! ALMO Code (in the spirit of the MP2 modifications below) - IF (ASSOCIATED(qs_env%almo_scf_env)) THEN - ! tell qs about the energy correction - NULLIFY (energy) - CALL get_qs_env(qs_env, energy=energy) - energy%total = energy%total+energy%singles_corr - END IF - -! ! ALMO Code (in the spirit of the MP2 modifications below) -! IF (ASSOCIATED(qs_env%almo_scf_env)) THEN -! ! tell qs about the energy correction -! NULLIFY (energy) -! CALL get_qs_env(qs_env, energy=energy) -! energy%total = energy%total+energy%singles_corr -! END IF - ! MP2 Code IF (ASSOCIATED(qs_env%mp2_env)) THEN NULLIFY (matrix_p_mp2, matrix_w_mp2, rho, ks_env, energy) diff --git a/src/qs_subsys_methods.F b/src/qs_subsys_methods.F index ef7f87e04d..f22dab868e 100644 --- a/src/qs_subsys_methods.F +++ b/src/qs_subsys_methods.F @@ -162,11 +162,10 @@ CONTAINS routineP = moduleN//':'//routineN INTEGER :: arbitrary_spin, iatom, ikind, imol, & - ispin, n_ao, natom, nmol_kind, nsgf, & - nspins, z_molecule + n_ao, natom, nmol_kind, nsgf, nspins, & + z_molecule INTEGER, DIMENSION(0:lmat, 10) :: ne_core, ne_elem, ne_explicit - INTEGER, DIMENSION(2) :: n_elec_alpha_and_beta, & - n_occ_alpha_and_beta + INTEGER, DIMENSION(2) :: n_occ_alpha_and_beta REAL(KIND=dp) :: charge_molecule, zeff, zeff_correction REAL(KIND=dp), DIMENSION(0:lmat, 10, 2) :: edelta TYPE(all_potential_type), POINTER :: all_potential @@ -183,6 +182,7 @@ CONTAINS natom = 0 ! *** Initialize the molecule kind data structure *** + ARBITRARY_SPIN = 1 DO imol = 1, nmol_kind molecule_kind => molecule_kind_set(imol) @@ -191,7 +191,6 @@ CONTAINS !nelectron = 0 n_ao = 0 n_occ_alpha_and_beta(1:nspins) = 0 - n_elec_alpha_and_beta(1:nspins) = 0 z_molecule = 0 DO iatom = 1, natom @@ -204,25 +203,30 @@ CONTAINS gth_potential=gth_potential, & sgp_potential=sgp_potential) - ! Get the electronic state of the atom that is used - ! to calculate the ATOMIC GUESS - ! The spin loop is becsause ATOMIC guess can be calculated twice - ! for two separate states with their own alpha-beta combinations - ! This is done to break the spin symmetry of the initial wfn + ! Obtain the electronic state of the atom + ! The same state is used to calculate the ATOMIC GUESS + ! It is great that we are consistent with ATOMIC_GUESS CALL init_atom_electronic_state(atomic_kind=atomic_kind, & qs_kind=qs_kind_set(ikind), & ncalc=ne_explicit, & ncore=ne_core, & nelem=ne_elem, & edelta=edelta) - DO ispin = 1, nspins - ! Get the number of electrons: explicit (i.e. with orbitals) and total - ! Note that it is impossible to separate alpha and beta electrons - ! because the mupliplicity of the atomic state is not specified in ATOMIC GUESS - n_occ_alpha_and_beta(ispin) = n_occ_alpha_and_beta(ispin)+SUM(ne_explicit)+ & - SUM(NINT(edelta(:, :, ispin))) - n_elec_alpha_and_beta(ispin) = n_elec_alpha_and_beta(ispin)+SUM(ne_elem) - ENDDO + + ! If &BS section is used ATOMIC_GUESS is calculated twice + ! for two separate wfns with their own alpha-beta combinations + ! This is done to break the spin symmetry of the initial wfn + ! For now, only alpha part of &BS is used to count electrons on + ! molecules + ! Get the number of explicit electrons (i.e. with orbitals) + ! For now, only the total number of electrons can be obtained + ! from init_atom_electronic_state + n_occ_alpha_and_beta(ARBITRARY_SPIN) = & + n_occ_alpha_and_beta(ARBITRARY_SPIN)+SUM(ne_explicit)+ & + SUM(NINT(2*edelta(:, :, ARBITRARY_SPIN))) + ! We need a way to specify the number of alpha and beta electrons + ! on each molecule (i.e. multiplicity is not enough) + !n_occ(ispin) = n_occ(ispin) + SUM(ne_explicit) + SUM(NINT(2*edelta(:, :, ispin))) IF (ASSOCIATED(all_potential)) THEN CALL get_potential(potential=all_potential, zeff=zeff, & @@ -254,13 +258,6 @@ CONTAINS ! At this point we have the number of electrons (alpha+beta) on the molecule ! as they are seen by the ATOMIC GUESS routines - ! First compare two copies of the ATOMIC GUESS - ! If they are different warn the user that only the ALPHA copy is currently - ! assigned to the molecule - ARBITRARY_SPIN = 1 -! IF( n_occ_alpha_and_beta(1).ne.n_occ_alpha_and_beta(2) ) THEN -! CPErrorMessage(cp_failure_level,routineP,"SECOND SPIN CONFIG IS IGNORED WHEN MOLECULAR STATES ARE ASSIGNED!") -! END IF charge_molecule = REAL(z_molecule-n_occ_alpha_and_beta(ARBITRARY_SPIN), dp) CALL set_molecule_kind(molecule_kind=molecule_kind, & nelectron=n_occ_alpha_and_beta(ARBITRARY_SPIN), & diff --git a/tests/QS/regtest-admm-dm/TEST_FILES b/tests/QS/regtest-admm-dm/TEST_FILES index 9f8ed71178..3853043202 100644 --- a/tests/QS/regtest-admm-dm/TEST_FILES +++ b/tests/QS/regtest-admm-dm/TEST_FILES @@ -5,7 +5,7 @@ CH3-BP-McWeeny.inp 1 2e-13 - CH3-BP-NONE_DM.inp 1 1e-13 -7.36784986949224 CH3-BP-NONE_DM_OT_OFF.inp 1 1.0E-14 -7.3980478715044704 CH4-BP-NONE_DM.inp 1 2e-13 -8.07630758920049 -CH4-BP-NONE_DM_OT_OFF.inp 1 2e-14 -8.0771213536441095 +CH4-BP-NONE_DM_OT_OFF.inp 1 2e-14 -8.07712135364430 2H2O-BLOCKED-NONE_DM.inp 1 3e-14 -34.077034488245907 -H2+-BLOCKED-NONE_DM.inp 1 3e-13 -0.45795647554813002 +H2+-BLOCKED-NONE_DM.inp 1 3e-13 -0.45795647554813002 #EOF diff --git a/tests/QS/regtest-almo-1/TEST_FILES b/tests/QS/regtest-almo-1/TEST_FILES index 272edb5da2..136d15f698 100644 --- a/tests/QS/regtest-almo-1/TEST_FILES +++ b/tests/QS/regtest-almo-1/TEST_FILES @@ -1,8 +1,8 @@ -almo-x.inp 11 1e-11 -137.653134569590435 -almo-guess.inp 11 1e-11 -137.653034945987258 -almo-scf.inp 11 1e-11 -137.652212420125409 -almo-d.inp 11 9e-12 -85.963926462173887 -almo-fullx.inp 11 1e-12 -137.653935641006086 -almo-fullx-then-scf.inp 11 -almo-then-wannier.inp 11 1e-12 -137.653115136269236 +almo-x.inp 11 1e-11 -137.653122944336531 +almo-guess.inp 11 1e-11 -137.653042893416284 +almo-scf.inp 11 1e-11 -137.652214083887657 +almo-d.inp 11 9e-12 -85.963944793676802 +almo-fullx.inp 11 1e-12 -137.653899517584335 +almo-fullx-then-scf.inp 11 1e-12 -137.653043387705907 +almo-then-wannier.inp 11 1e-12 -137.653091046048360 #EOF diff --git a/tests/QS/regtest-almo-1/almo-then-wannier.inp b/tests/QS/regtest-almo-1/almo-then-wannier.inp index 4acf33d5de..33c2c210cb 100644 --- a/tests/QS/regtest-almo-1/almo-then-wannier.inp +++ b/tests/QS/regtest-almo-1/almo-then-wannier.inp @@ -17,6 +17,7 @@ EPS_FILTER 1.0E-8 ALMO_ALGORITHM DIAG ALMO_SCF_GUESS ATOMIC + RETURN_ORTHOGONALIZED_MOS TRUE &ALMO_OPTIMIZER_DIIS MAX_ITER 10 diff --git a/tests/QS/regtest-almo-1/almo-x.inp b/tests/QS/regtest-almo-1/almo-x.inp index 9baab74d1b..16401d919e 100644 --- a/tests/QS/regtest-almo-1/almo-x.inp +++ b/tests/QS/regtest-almo-1/almo-x.inp @@ -17,6 +17,11 @@ EPS_FILTER 1.0E-8 ALMO_ALGORITHM DIAG ALMO_SCF_GUESS ATOMIC + MO_OVERLAP_INV_ALG LS_TAYLOR + + &MATRIX_ITERATE + EPS_TARGET_FACTOR 1 + &END &ALMO_OPTIMIZER_DIIS MAX_ITER 10 diff --git a/tests/QS/regtest-almo-2/FH-chain.inp b/tests/QS/regtest-almo-2/FH-chain.inp index e70dd05ca2..63061d2613 100644 --- a/tests/QS/regtest-almo-2/FH-chain.inp +++ b/tests/QS/regtest-almo-2/FH-chain.inp @@ -17,6 +17,7 @@ EPS_FILTER 1.0E-8 ALMO_ALGORITHM DIAG ALMO_SCF_GUESS ATOMIC + RETURN_ORTHOGONALIZED_MOS F &ALMO_OPTIMIZER_DIIS MAX_ITER 30 @@ -33,7 +34,7 @@ CONJUGATOR FLETCHER LIN_SEARCH_EPS_ERROR 0.05 LIN_SEARCH_STEP_SIZE_GUESS 0.1 - MAX_ITER_OUTER_LOOP 0 + MAX_ITER_OUTER_LOOP 2 &END XALMO_OPTIMIZER_PCG &END ALMO_SCF diff --git a/tests/QS/regtest-almo-2/TEST_FILES b/tests/QS/regtest-almo-2/TEST_FILES index da922d7d17..0201995ab6 100644 --- a/tests/QS/regtest-almo-2/TEST_FILES +++ b/tests/QS/regtest-almo-2/TEST_FILES @@ -1,6 +1,8 @@ -almo-fullx.inp 11 1e-11 -137.653972983204994 -almo-no-deloc.inp 11 9e-12 -137.557304851561014 +almo-fullx.inp 11 1e-11 -137.653869649992146 +almo-no-deloc.inp 11 9e-12 -137.557304848837759 FH-chain.inp 11 3e-10 -98.108319997143496 -ion-pair.inp 11 1e-13 -115.006279154085647 -LiF.inp 11 3e-12 -127.53931597060651 +ion-pair.inp 11 1e-13 -115.006279649267199 +LiF.inp 11 3e-12 -127.539319485641016 +zero-electron-frag.inp 11 1e-08 -98.728605260047331 +matrix-iterate.inp 11 1e-09 -127.379124535900814 #EOF diff --git a/tests/QS/regtest-almo-2/matrix-iterate.inp b/tests/QS/regtest-almo-2/matrix-iterate.inp new file mode 100644 index 0000000000..f3b4d19d9f --- /dev/null +++ b/tests/QS/regtest-almo-2/matrix-iterate.inp @@ -0,0 +1,117 @@ +&GLOBAL + PROJECT iterate + RUN_TYPE ENERGY + PRINT_LEVEL LOW +&END GLOBAL +&FORCE_EVAL + METHOD QS + &DFT + BASIS_SET_FILE_NAME GTH_BASIS_SETS + POTENTIAL_FILE_NAME POTENTIAL + &MGRID + CUTOFF 200 + NGRIDS 4 + &END MGRID + &QS + ALMO_SCF T + EPS_DEFAULT 1.0E-9 + &END QS + + &ALMO_SCF + + EPS_FILTER 1.0E-8 + ALMO_ALGORITHM DIAG + DELOCALIZE_METHOD XALMO_SCF + XALMO_R_CUTOFF_FACTOR 0.6 + ALMO_SCF_GUESS ATOMIC + + &MATRIX_ITERATE + EPS_TARGET_FACTOR 100. + EPS_LANCZOS 1.0E-3 + MAX_ITER_LANCZOS 64 + ORDER_LANCZOS 3 + &END MATRIX_ITERATE + + &ALMO_OPTIMIZER_DIIS + MAX_ITER 100 + N_DIIS 5 + EPS_ERROR 1.0E-5 + &END ALMO_OPTIMIZER_DIIS + + &XALMO_OPTIMIZER_PCG + MAX_ITER 30 + EPS_ERROR 1.0E-7 + CONJUGATOR HESTENES_STIEFEL + PRECONDITIONER DEFAULT + LIN_SEARCH_EPS_ERROR 0.05 + LIN_SEARCH_STEP_SIZE_GUESS 0.1 + MAX_ITER_OUTER_LOOP 2 + &END XALMO_OPTIMIZER_PCG + + &END ALMO_SCF + + &XC + &XC_FUNCTIONAL PBE + &END XC_FUNCTIONAL + &END XC + + &END DFT + + &SUBSYS + &CELL + ABC 4.0351 4.0351 4.0351 + MULTIPLE_UNIT_CELL 1 1 1 + &END CELL + &TOPOLOGY + MULTIPLE_UNIT_CELL 1 1 1 + &END + &COORD + SCALED + Li 0.0 0.0 0.0 Li-plus + Li 0.5 0.5 0.0 Li-plus + Li 0.5 0.0 0.5 Li-plus + Li 0.0 0.5 0.5 Li-plus + F 0.0 0.0 0.5 F-minus + F 0.0 0.5 0.0 F-minus + F 0.5 0.0 0.0 F-minus + F 0.5 0.5 0.5 F-minus + &END COORD + &KIND Li + BASIS_SET DZVP-GTH + POTENTIAL GTH-BLYP-q3 + &BS + &ALPHA + NEL -1 + L 0 + N 2 + &END + ! BETA FUNCTION SHOULD BE THE SAME + ! TO AVOID WARNINGS + &BETA + NEL -1 + L 0 + N 2 + &END + &END + &END KIND + &KIND F + BASIS_SET DZVP-GTH + POTENTIAL GTH-BLYP-q7 + &BS + &ALPHA + NEL +1 + L 1 + N 2 + &END + ! BETA FUNCTION SHOULD BE THE SAME + ! TO AVOID WARNINGS + &BETA + NEL +1 + L 1 + N 2 + &END + &END + &END KIND + &END SUBSYS +&END FORCE_EVAL + diff --git a/tests/QS/regtest-almo-2/zero-electron-frag.inp b/tests/QS/regtest-almo-2/zero-electron-frag.inp new file mode 100644 index 0000000000..6ef93ff54d --- /dev/null +++ b/tests/QS/regtest-almo-2/zero-electron-frag.inp @@ -0,0 +1,112 @@ +&GLOBAL + PROJECT LiF-chain + RUN_TYPE ENERGY + PRINT_LEVEL LOW +&END GLOBAL +&FORCE_EVAL + METHOD QS + &DFT + POTENTIAL_FILE_NAME GTH_POTENTIALS + BASIS_SET_FILE_NAME GTH_BASIS_SETS + &QS + ALMO_SCF T + EPS_DEFAULT 1.0E-8 ! 1.0E-12 + &END QS + + &ALMO_SCF + EPS_FILTER 1.0E-8 + ALMO_ALGORITHM DIAG + ALMO_SCF_GUESS ATOMIC + + &ALMO_OPTIMIZER_DIIS + MAX_ITER 30 + EPS_ERROR 5.0E-4 + N_DIIS 7 + &END ALMO_OPTIMIZER_DIIS + + DELOCALIZE_METHOD XALMO_SCF + XALMO_R_CUTOFF_FACTOR 1.2 + + &XALMO_OPTIMIZER_PCG + MAX_ITER 100 + EPS_ERROR 5.0E-4 + CONJUGATOR FLETCHER + LIN_SEARCH_EPS_ERROR 0.05 + LIN_SEARCH_STEP_SIZE_GUESS 0.1 + MAX_ITER_OUTER_LOOP 0 + &END XALMO_OPTIMIZER_PCG + + &END ALMO_SCF + + &MGRID + CUTOFF 200 ! 320 + NGRIDS 5 + &END MGRID + &XC + &XC_FUNCTIONAL BLYP + &END XC_FUNCTIONAL + &END XC + &END DFT + &SUBSYS + &CELL + ABC 5.0000000000 5.0000000000 10.0000000000 + MULTIPLE_UNIT_CELL 1 1 1 + &END CELL + &TOPOLOGY + MULTIPLE_UNIT_CELL 1 1 1 + &END + &COORD + ! atomic decomposition + H 0.0000000000 0.0000000000 0.0000000000 H1 + F 0.0000000000 0.0000000000 1.0000000000 F1 + H 0.0000000000 0.0000000000 3.0000000000 H2 + F 0.0000000000 1.0000000000 3.0000000000 F2 + H 0.0000000000 0.0000000000 6.0000000000 H3 + F 0.0000000000 0.0000000000 5.0000000000 F3 + H 0.0000000000 1.0000000000 8.0000000000 H4 + F 0.0000000000 0.0000000000 8.0000000000 F4 + ! molecular decomposition + !H 0.0000000000 0.0000000000 0.0000000000 HF1 + !F 0.0000000000 0.0000000000 1.0000000000 HF1 + !H 0.0000000000 0.0000000000 3.0000000000 HF2 + !F 0.0000000000 1.0000000000 3.0000000000 HF2 + !H 0.0000000000 0.0000000000 6.0000000000 HF3 + !F 0.0000000000 0.0000000000 5.0000000000 HF3 + !H 0.0000000000 1.0000000000 8.0000000000 HF4 + !F 0.0000000000 0.0000000000 8.0000000000 HF4 + &END COORD + &KIND H + BASIS_SET DZVP-GTH + POTENTIAL GTH-BLYP-q1 + &BS + &ALPHA + NEL -1 + L 0 + N 1 + &END + &BETA + NEL -1 + L 0 + N 1 + &END + &END + &END KIND + &KIND F + BASIS_SET DZVP-GTH + POTENTIAL GTH-BLYP-q7 + &BS + &ALPHA + NEL +1 + L 1 + N 2 + &END + &BETA + NEL +1 + L 1 + N 2 + &END + &END + &END KIND + &END SUBSYS +&END FORCE_EVAL + diff --git a/tests/QS/regtest-almo-eda/TEST_FILES b/tests/QS/regtest-almo-eda/TEST_FILES index 633df65af3..85662414b4 100644 --- a/tests/QS/regtest-almo-eda/TEST_FILES +++ b/tests/QS/regtest-almo-eda/TEST_FILES @@ -1,2 +1,2 @@ -almo-eda-x.inp 11 1e-08 -85.963728515581991 +almo-eda-x.inp 11 1e-08 -85.963743073641155 #EOF diff --git a/tests/QS/regtest-almo-md/TEST_FILES b/tests/QS/regtest-almo-md/TEST_FILES index 1a01ddc2f0..b0b8cd538e 100644 --- a/tests/QS/regtest-almo-md/TEST_FILES +++ b/tests/QS/regtest-almo-md/TEST_FILES @@ -1,7 +1,7 @@ -almo-md-full-scf.inp 11 -almo-md-full-x-then-scf.inp 11 -almo-md-no-aspc.inp 11 -xalmo-scf-md.inp 11 -almo-md.inp 11 -almo-md-wannier.inp 11 +almo-md-full-scf.inp 11 1.e-12 -136.705845206653748 +almo-md-full-x-then-scf.inp 11 1.e-12 -136.986095053499298 +almo-md-no-aspc.inp 11 1.e-12 -136.473484271103160 +xalmo-scf-md.inp 11 1.e-12 -136.705599282831827 +almo-md.inp 11 1.e-12 -136.622582483465919 +almo-md-wannier.inp 11 1.e-12 -136.473478972490227 #EOF diff --git a/tests/QS/regtest-almo-md/almo-md-wannier.inp b/tests/QS/regtest-almo-md/almo-md-wannier.inp index e6689e552e..fe1fcb8567 100644 --- a/tests/QS/regtest-almo-md/almo-md-wannier.inp +++ b/tests/QS/regtest-almo-md/almo-md-wannier.inp @@ -36,7 +36,9 @@ DELOCALIZE_METHOD NONE XALMO_R_CUTOFF_FACTOR 1.4 - + + RETURN_ORTHOGONALIZED_MOS TRUE + &XALMO_OPTIMIZER_PCG MAX_ITER 100 EPS_ERROR 5.0E-4 diff --git a/tests/QS/regtest-almo-strong/BNH2-sheet.inp b/tests/QS/regtest-almo-strong/BNH2-sheet.inp new file mode 100644 index 0000000000..04451adf62 --- /dev/null +++ b/tests/QS/regtest-almo-strong/BNH2-sheet.inp @@ -0,0 +1,147 @@ +&GLOBAL + PROJECT BNH + RUN_TYPE ENERGY + PRINT_LEVEL LOW + !TRACE TRUE +&END GLOBAL +&FORCE_EVAL + METHOD QS + STRESS_TENSOR ANALYTICAL + &DFT + POTENTIAL_FILE_NAME GTH_POTENTIALS + BASIS_SET_FILE_NAME GTH_BASIS_SETS + &QS + ALMO_SCF T + EPS_DEFAULT 1.E-8 !1.0E-14 + &END QS + + &ALMO_SCF + EPS_FILTER 1.0E-8 !1.0E-12 + ALMO_ALGORITHM DIAG + ALMO_SCF_GUESS ATOMIC + + &ALMO_OPTIMIZER_DIIS + MAX_ITER 100 + EPS_ERROR 1.0E-3 !1.0E-6 + N_DIIS 5 + &END ALMO_OPTIMIZER_DIIS + + DELOCALIZE_METHOD XALMO_SCF + XALMO_R_CUTOFF_FACTOR 0.6 + + &XALMO_OPTIMIZER_PCG + MAX_ITER 100 + EPS_ERROR 1.0E-3 !1.0E-6 + CONJUGATOR FLETCHER_REEVES + LIN_SEARCH_EPS_ERROR 0.01 + LIN_SEARCH_STEP_SIZE_GUESS 0.2 + MAX_ITER_OUTER_LOOP 0 + &END XALMO_OPTIMIZER_PCG + + &END ALMO_SCF + + &MGRID + CUTOFF 200 !600 + NGRIDS 5 + &END MGRID + &XC + &XC_FUNCTIONAL PBE + &END XC_FUNCTIONAL + &END XC + &END DFT + + &SUBSYS + &CELL + ABC 2.647 2.647 5.0 + ALPHA_BETA_GAMMA 90.0 90.0 120.0 + MULTIPLE_UNIT_CELL 1 1 1 + &END CELL + &TOPOLOGY + !&GENERATE + ! BONDLENGTH_MAX 5.2 + !&END GENERATE + MULTIPLE_UNIT_CELL 1 1 1 + &END + &COORD + B 0.0000 0.0000 0.1936 B1 + Hm 0.0000 0.0000 1.3944 B1 + N 0.0000 1.5282 -0.2704 N1 + Hp 0.0000 1.5282 -1.3173 N1 + &END COORD + &KIND Hp + ELEMENT H + BASIS_SET SZV-GTH + POTENTIAL GTH-BLYP-q1 + !&BS + ! &ALPHA + ! NEL -1 + ! L 0 + ! N 1 + ! &END + ! ! BETA FUNCTION SHOULD BE THE SAME + ! ! TO AVOID WARNINGS + ! &BETA + ! NEL -1 + ! L 0 + ! N 1 + ! &END + !&END + &END KIND + &KIND Hm + ELEMENT H + BASIS_SET SZV-GTH + POTENTIAL GTH-BLYP-q1 + !&BS + ! &ALPHA + ! NEL 1 + ! L 0 + ! N 1 + ! &END + ! ! BETA FUNCTION SHOULD BE THE SAME + ! ! TO AVOID WARNINGS + ! &BETA + ! NEL 1 + ! L 0 + ! N 1 + ! &END + !&END + &END KIND + &KIND N + BASIS_SET SZV-GTH + POTENTIAL GTH-BLYP-q5 + &BS + &ALPHA + NEL 2 + L 1 + N 2 + &END + ! BETA FUNCTION SHOULD BE THE SAME + ! TO AVOID WARNINGS + &BETA + NEL 2 + L 1 + N 2 + &END + &END + &END KIND + &KIND B + BASIS_SET SZV-GTH + POTENTIAL GTH-BLYP-q3 + &BS + &ALPHA + NEL -1 -1 + L 0 1 + N 2 2 + &END + ! BETA FUNCTION SHOULD BE THE SAME + ! TO AVOID WARNINGS + &BETA + NEL -1 -1 + L 0 1 + N 2 2 + &END + &END + &END KIND + &END SUBSYS +&END FORCE_EVAL + diff --git a/tests/QS/regtest-almo-strong/FH-chain.strong.inp b/tests/QS/regtest-almo-strong/FH-chain.strong.inp new file mode 100644 index 0000000000..a5aab96d3c --- /dev/null +++ b/tests/QS/regtest-almo-strong/FH-chain.strong.inp @@ -0,0 +1,113 @@ +&GLOBAL + PROJECT LiF-chain + RUN_TYPE ENERGY + PRINT_LEVEL LOW +&END GLOBAL +&FORCE_EVAL + METHOD QS + &DFT + POTENTIAL_FILE_NAME GTH_POTENTIALS + BASIS_SET_FILE_NAME GTH_BASIS_SETS + &QS + ALMO_SCF T + EPS_DEFAULT 1.0E-8 ! 1.0E-12 + &END QS + + &ALMO_SCF + EPS_FILTER 1.0E-8 + ALMO_ALGORITHM SKIP + ALMO_SCF_GUESS ATOMIC + XALMO_TRIAL_WF SIMPLE + + &ALMO_OPTIMIZER_DIIS + MAX_ITER 30 + EPS_ERROR 5.0E-4 + N_DIIS 7 + &END ALMO_OPTIMIZER_DIIS + + DELOCALIZE_METHOD XALMO_SCF + XALMO_R_CUTOFF_FACTOR 1.2 + + &XALMO_OPTIMIZER_PCG + MAX_ITER 50 + EPS_ERROR 5.0E-4 + CONJUGATOR FLETCHER + LIN_SEARCH_EPS_ERROR 0.05 + LIN_SEARCH_STEP_SIZE_GUESS 0.1 + MAX_ITER_OUTER_LOOP 2 + &END XALMO_OPTIMIZER_PCG + + &END ALMO_SCF + + &MGRID + CUTOFF 200 ! 320 + NGRIDS 5 + &END MGRID + &XC + &XC_FUNCTIONAL BLYP + &END XC_FUNCTIONAL + &END XC + &END DFT + &SUBSYS + &CELL + ABC 3.0000000000 3.0000000000 10.0000000000 + MULTIPLE_UNIT_CELL 1 1 1 + &END CELL + &TOPOLOGY + MULTIPLE_UNIT_CELL 1 1 1 + &END + &COORD + ! atomic decomposition + H 0.0000000000 0.0000000000 0.0000000000 H1 + F 0.0000000000 0.0000000000 1.0000000000 F1 + H 0.0000000000 0.0000000000 3.0000000000 H2 + F 0.0000000000 1.0000000000 3.0000000000 F2 + H 0.0000000000 0.0000000000 6.0000000000 H3 + F 0.0000000000 0.0000000000 5.0000000000 F3 + H 0.0000000000 1.0000000000 8.0000000000 H4 + F 0.0000000000 0.0000000000 8.0000000000 F4 + ! molecular decomposition + !H 0.0000000000 0.0000000000 0.0000000000 HF1 + !F 0.0000000000 0.0000000000 1.0000000000 HF1 + !H 0.0000000000 0.0000000000 3.0000000000 HF2 + !F 0.0000000000 1.0000000000 3.0000000000 HF2 + !H 0.0000000000 0.0000000000 6.0000000000 HF3 + !F 0.0000000000 0.0000000000 5.0000000000 HF3 + !H 0.0000000000 1.0000000000 8.0000000000 HF4 + !F 0.0000000000 0.0000000000 8.0000000000 HF4 + &END COORD + &KIND H + BASIS_SET DZVP-GTH + POTENTIAL GTH-BLYP-q1 + &BS + &ALPHA + NEL -1 + L 0 + N 1 + &END + &BETA + NEL -1 + L 0 + N 1 + &END + &END + &END KIND + &KIND F + BASIS_SET DZVP-GTH + POTENTIAL GTH-BLYP-q7 + &BS + &ALPHA + NEL +1 + L 1 + N 2 + &END + &BETA + NEL +1 + L 1 + N 2 + &END + &END + &END KIND + &END SUBSYS +&END FORCE_EVAL + diff --git a/tests/QS/regtest-almo-strong/TEST_FILES b/tests/QS/regtest-almo-strong/TEST_FILES new file mode 100644 index 0000000000..1fd2c7d875 --- /dev/null +++ b/tests/QS/regtest-almo-strong/TEST_FILES @@ -0,0 +1,5 @@ +atomic-water.inp 11 1e-08 -33.939454719891792 +bn.inp 11 1e-10 -50.599959228858097 +BNH2-sheet.inp 11 1e-08 -13.641848381243719 +FH-chain.strong.inp 11 1e-08 -98.638850796080803 +#EOF diff --git a/tests/QS/regtest-almo-strong/atomic-water.inp b/tests/QS/regtest-almo-strong/atomic-water.inp new file mode 100644 index 0000000000..fbc2d4fa9f --- /dev/null +++ b/tests/QS/regtest-almo-strong/atomic-water.inp @@ -0,0 +1,132 @@ +&GLOBAL + PROJECT md-atomic-part + RUN_TYPE MD + PRINT_LEVEL LOW +&END GLOBAL + +&MOTION + &MD + ENSEMBLE NVE + STEPS 4 + TIMESTEP 0.5 + TEMPERATURE 298 + &END MD +&END MOTION + +&FORCE_EVAL + METHOD QS + &DFT + + BASIS_SET_FILE_NAME GTH_BASIS_SETS + POTENTIAL_FILE_NAME POTENTIAL + + &MGRID + CUTOFF 400 + &END MGRID + + &QS + ALMO_SCF T + EPS_DEFAULT 1.0E-8 ! 1.0E-12 + WF_INTERPOLATION PS + &END QS + + &ALMO_SCF + EPS_FILTER 1.0E-8 ! 1.0E-11 + ALMO_ALGORITHM SKIP + ALMO_SCF_GUESS ATOMIC + MO_OVERLAP_INV_ALG DENSE_CHOLESKY + XALMO_TRIAL_WF SIMPLE + DELOCALIZE_METHOD XALMO_SCF + XALMO_R_CUTOFF_FACTOR 1.3 + XALMO_EXTRAPOLATION_ORDER 4 + + &MATRIX_ITERATE + EPS_TARGET_FACTOR 10. + !EPS_LANCZOS 1.0E-3 + !MAX_ITER_LANCZOS 64 + !ORDER_LANCZOS 3 + &END MATRIX_ITERATE + + &XALMO_OPTIMIZER_PCG + MAX_ITER 15 + EPS_ERROR 5.0E-5 + CONJUGATOR FLETCHER_REEVES + LIN_SEARCH_EPS_ERROR 0.05 + LIN_SEARCH_STEP_SIZE_GUESS 0.1 + MAX_ITER_OUTER_LOOP 50 + PRECOND_FILTER_THRESHOLD 0.008 + &END XALMO_OPTIMIZER_PCG + + &END ALMO_SCF + + &XC + &XC_FUNCTIONAL BLYP + &END XC_FUNCTIONAL + &END XC + + &END DFT + + &SUBSYS + + &KIND H + BASIS_SET SZV-GTH ! TZV2P-GTH + POTENTIAL GTH-BLYP-q1 + &BS + &ALPHA + NEL -1 + L 0 + N 1 + &END + ! BETA FUNCTION SHOULD BE THE SAME TO AVOID WARNINGS + &BETA + NEL -1 + L 0 + N 1 + &END + &END + &END KIND + + &KIND O + BASIS_SET SZV-GTH ! TZV2P-GTH + POTENTIAL GTH-BLYP-q6 + &BS + &ALPHA + NEL +2 + L 1 + N 2 + &END + ! BETA FUNCTION SHOULD BE THE SAME TO AVOID WARNINGS + &BETA + NEL +2 + L 1 + N 2 + &END + &END + &END KIND + + &CELL + ABC 3.00000000 3.00000000 5.00000000 + MULTIPLE_UNIT_CELL 1 1 1 + &END CELL + + &TOPOLOGY + &GENERATE # fragments contain single atoms + BONDLENGTH_MAX 1.0 + BONDPARM COVALENT + BONDPARM_FACTOR 0.3 + &END GENERATE + MULTIPLE_UNIT_CELL 1 1 1 + &END + + &COORD + O 1.5285821781 1.7062403635 3.9140529453 + H 1.6296675630 1.2721242389 4.7873221686 + H 2.0421991683 2.5306450214 4.0774366182 + O 1.6497475797 0.9866814243 1.1082336734 + H 1.5853337875 1.1818653541 2.0640644445 + H 0.6898667621 0.8787694446 0.8082114051 + &END COORD + + &END SUBSYS +&END FORCE_EVAL + diff --git a/tests/QS/regtest-almo-strong/bn.inp b/tests/QS/regtest-almo-strong/bn.inp new file mode 100644 index 0000000000..64b1f3474e --- /dev/null +++ b/tests/QS/regtest-almo-strong/bn.inp @@ -0,0 +1,114 @@ + +&GLOBAL + PROJECT BN_neg + RUN_TYPE ENERGY + PRINT_LEVEL LOW +&END GLOBAL + +&FORCE_EVAL + METHOD QS + &DFT + + BASIS_SET_FILE_NAME GTH_BASIS_SETS + POTENTIAL_FILE_NAME GTH_POTENTIALS + + &QS + METHOD GPW + ALMO_SCF T + EPS_DEFAULT 1.0E-10 ! 1.0E-11 + &END QS + + &MGRID + CUTOFF 200 ! 600 + NGRIDS 4 + &END MGRID + + &ALMO_SCF + EPS_FILTER 1.0E-9 ! 1.0E-10 + ALMO_ALGORITHM SKIP + ALMO_SCF_GUESS ATOMIC + MO_OVERLAP_INV_ALG DENSE_CHOLESKY + DELOCALIZE_METHOD XALMO_SCF + XALMO_R_CUTOFF_FACTOR 0.6 + XALMO_TRIAL_WF SIMPLE + RETURN_ORTHOGONALIZED_MOS FALSE + + &XALMO_OPTIMIZER_PCG + MAX_ITER 15 + EPS_ERROR 1.0E-5 + CONJUGATOR DAI_YUAN + LIN_SEARCH_EPS_ERROR 0.01 + LIN_SEARCH_STEP_SIZE_GUESS 0.05 + MAX_ITER_OUTER_LOOP 10 + PRECOND_FILTER_THRESHOLD 0.05 + &END XALMO_OPTIMIZER_PCG + + &END ALMO_SCF + + &XC + &XC_FUNCTIONAL BLYP + &END XC_FUNCTIONAL + &END XC + + &END DFT + + &SUBSYS + &CELL + ABC 3.66 3.66 3.66 + MULTIPLE_UNIT_CELL 1 1 1 + &END CELL + + &COORD + SCALED T + B 0.0000000000 0.0000000000 0.0000000000 + B 0.50000000 0.50000000 0.0000000000 + B 0.50000000 0.0000000000 0.50000000 + B 0.0000000000 0.50000000 0.50000000 + N 0.25000000 0.25000000 0.25000000 + N 0.75000000 0.75000000 0.25000000 + N 0.75000000 0.25000000 0.75000000 + N 0.25000000 0.75000000 0.75000000 + &END COORD + + &KIND B + BASIS_SET SZV-GTH-q3 ! DZVP-GTH-q3 + POTENTIAL GTH-BLYP-q3 + &BS + &ALPHA + NEL -1 -2 + L 1 0 + N 2 2 + &END + ! BETA FUNCTION SHOULD BE THE SAME + ! TO AVOID WARNINGS + &BETA + NEL -1 -2 + L 1 0 + N 2 2 + &END + &END + &END KIND + + &KIND N + BASIS_SET SZV-GTH-q5 ! DZVP-GTH-q5 + POTENTIAL GTH-BLYP-q5 + &BS + &ALPHA + NEL +3 + L 1 + N 2 + &END + ! BETA FUNCTION SHOULD BE THE SAME + ! TO AVOID WARNINGS + &BETA + NEL +3 + L 1 + N 2 + &END + &END + &END KIND + + &END SUBSYS + +&END FORCE_EVAL + diff --git a/tests/QS/regtest-dm-ls-scf-1/TEST_FILES b/tests/QS/regtest-dm-ls-scf-1/TEST_FILES index 40f4840275..6ea430b6d5 100644 --- a/tests/QS/regtest-dm-ls-scf-1/TEST_FILES +++ b/tests/QS/regtest-dm-ls-scf-1/TEST_FILES @@ -1,7 +1,7 @@ H2-big-1.inp 11 2e-13 -27.808422055041142 H2-big-2.inp 11 1e-13 -27.808422055528268 H2-big-3.inp 11 7e-13 -27.808586398678841 -H2-big-4.inp 11 6e-13 -27.809113704800708 +H2-big-4.inp 11 6e-13 -27.808505168773813 H2-big-5.inp 11 2e-13 -18.233645147453636 H2-big-6.inp 11 2e-13 -18.233645147453636 H2-big-7.inp 11 2e-13 -27.808422055041142 diff --git a/tests/QS/regtest-kg/TEST_FILES b/tests/QS/regtest-kg/TEST_FILES index f996e64259..75cf6fe55e 100644 --- a/tests/QS/regtest-kg/TEST_FILES +++ b/tests/QS/regtest-kg/TEST_FILES @@ -22,7 +22,7 @@ H2_H2O_lsks.inp 11 1e-10 - H2_H2O_ec.inp 66 1e-10 -18.4641086282 H2_H2O_ecprim.inp 66 1e-10 -18.4071025433 2H2O_ecmao.inp 66 1e-10 -34.0838901711 -2H2O_ecmao2.inp 66 1e-08 -34.5024811487 +2H2O_ecmao2.inp 66 1e-08 -34.5024586832 H2-none.inp 11 7e-07 -3.359680469888914 H2_H2O-vdW.inp 11 1e-10 -18.149003390914348 H2_H2O-lri.inp 72 3e-02 0.00011458 diff --git a/tests/QS/regtest-rma/TEST_FILES b/tests/QS/regtest-rma/TEST_FILES index d7f39e5697..78c9f75d7d 100644 --- a/tests/QS/regtest-rma/TEST_FILES +++ b/tests/QS/regtest-rma/TEST_FILES @@ -1,7 +1,7 @@ H2O-32-dftb-ls-2_mult.inp 11 1e-12 -32.574187310759356 H2O-32-dftb-ls-2.inp 11 1e-12 -32.574187310759356 -H2O-OT-ASPC-1.inp 1 4e-14 -17.13993294772316 -H2O-OT-ASPC-1_clusters.inp 1 4e-14 -17.13993294772316 +H2O-OT-ASPC-1.inp 1 4e-14 -17.13993294716181 +H2O-OT-ASPC-1_clusters.inp 1 4e-14 -17.13993294716182 H2-big-nimages.inp 11 2e-13 -27.808422055041138 H2-big-nimages_clusters.inp 11 2e-13 -27.808422055041142 H2O_grad_gpw.inp 11 7e-11 -17.082584774463687 diff --git a/tests/TEST_DIRS b/tests/TEST_DIRS index 00ad553de0..1f73c136ef 100644 --- a/tests/TEST_DIRS +++ b/tests/TEST_DIRS @@ -57,6 +57,7 @@ QS/regtest-admm-4 libint ATOM/regtest-1 QS/regtest-gw-ic-model QS/regtest-almo-md +QS/regtest-almo-strong QS/regtest-pao-1 QS/regtest-ri-mp2 libint QS/regtest-almo-2