1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief Contains methods used in the context of density fitting 8!> \par History 9!> 04.2008 created [Manuel Guidon] 10!> 02.2013 moved from admm_methods 11!> \author Manuel Guidon 12! ************************************************************************************************** 13MODULE admm_utils 14 USE admm_types, ONLY: admm_type 15 USE cp_dbcsr_operations, ONLY: copy_fm_to_dbcsr 16 USE cp_gemm_interface, ONLY: cp_gemm 17 USE dbcsr_api, ONLY: dbcsr_add,& 18 dbcsr_copy,& 19 dbcsr_create,& 20 dbcsr_deallocate_matrix,& 21 dbcsr_set,& 22 dbcsr_type,& 23 dbcsr_type_symmetric 24 USE input_constants, ONLY: do_admm_purify_cauchy,& 25 do_admm_purify_cauchy_subspace,& 26 do_admm_purify_mo_diag,& 27 do_admm_purify_mo_no_diag,& 28 do_admm_purify_none 29 USE kinds, ONLY: dp 30#include "./base/base_uses.f90" 31 32 IMPLICIT NONE 33 PRIVATE 34 35 PUBLIC :: admm_correct_for_eigenvalues, & 36 admm_uncorrect_for_eigenvalues 37 38 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'admm_utils' 39 40!*** 41 42CONTAINS 43 44! ************************************************************************************************** 45!> \brief ... 46!> \param ispin ... 47!> \param admm_env ... 48!> \param ks_matrix ... 49! ************************************************************************************************** 50 SUBROUTINE admm_correct_for_eigenvalues(ispin, admm_env, ks_matrix) 51 INTEGER, INTENT(IN) :: ispin 52 TYPE(admm_type), POINTER :: admm_env 53 TYPE(dbcsr_type), POINTER :: ks_matrix 54 55 INTEGER :: nao_aux_fit, nao_orb 56 TYPE(dbcsr_type), POINTER :: work 57 58 nao_aux_fit = admm_env%nao_aux_fit 59 nao_orb = admm_env%nao_orb 60 61 IF (.NOT. admm_env%block_dm) THEN 62 SELECT CASE (admm_env%purification_method) 63 CASE (do_admm_purify_cauchy_subspace) 64 !* remove what has been added and add the correction 65 NULLIFY (work) 66 ALLOCATE (work) 67 CALL dbcsr_create(work, template=ks_matrix, name='work', matrix_type=dbcsr_type_symmetric) 68 69 CALL dbcsr_copy(work, ks_matrix) 70 CALL dbcsr_set(work, 0.0_dp) 71 CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.) 72 73 CALL dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp) 74 75 ! ** calculate A^T*H_tilde*A 76 CALL cp_gemm('N', 'N', nao_aux_fit, nao_orb, nao_aux_fit, & 77 1.0_dp, admm_env%K(ispin)%matrix, admm_env%A, 0.0_dp, & 78 admm_env%work_aux_orb) 79 CALL cp_gemm('T', 'N', nao_orb, nao_orb, nao_aux_fit, & 80 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, & 81 admm_env%H_corr(ispin)%matrix) 82 83 CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.) 84 85 CALL dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp) 86 CALL dbcsr_deallocate_matrix(work) 87 88 CASE (do_admm_purify_mo_diag) 89 !* remove what has been added and add the correction 90 NULLIFY (work) 91 ALLOCATE (work) 92 CALL dbcsr_create(work, template=ks_matrix, name='work', matrix_type=dbcsr_type_symmetric) 93 94 CALL dbcsr_copy(work, ks_matrix) 95 CALL dbcsr_set(work, 0.0_dp) 96 CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.) 97 98 ! ** calculate A^T*H_tilde*A 99 CALL cp_gemm('N', 'N', nao_aux_fit, nao_orb, nao_aux_fit, & 100 1.0_dp, admm_env%K(ispin)%matrix, admm_env%A, 0.0_dp, & 101 admm_env%work_aux_orb) 102 CALL cp_gemm('T', 'N', nao_orb, nao_orb, nao_aux_fit, & 103 1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, & 104 admm_env%H_corr(ispin)%matrix) 105 106 CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.) 107 108 CALL dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp) 109 CALL dbcsr_deallocate_matrix(work) 110 111 CASE (do_admm_purify_mo_no_diag, do_admm_purify_none, do_admm_purify_cauchy) 112 ! do nothing 113 END SELECT 114 ENDIF 115 116 END SUBROUTINE admm_correct_for_eigenvalues 117 118! ************************************************************************************************** 119!> \brief ... 120!> \param ispin ... 121!> \param admm_env ... 122!> \param ks_matrix ... 123! ************************************************************************************************** 124 SUBROUTINE admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_matrix) 125 INTEGER, INTENT(IN) :: ispin 126 TYPE(admm_type), POINTER :: admm_env 127 TYPE(dbcsr_type), POINTER :: ks_matrix 128 129 INTEGER :: nao_aux_fit, nao_orb 130 TYPE(dbcsr_type), POINTER :: work 131 132 nao_aux_fit = admm_env%nao_aux_fit 133 nao_orb = admm_env%nao_orb 134 135 IF (.NOT. admm_env%block_dm) THEN 136 SELECT CASE (admm_env%purification_method) 137 CASE (do_admm_purify_cauchy_subspace) 138 !* remove what has been added and add the correction 139 NULLIFY (work) 140 ALLOCATE (work) 141 CALL dbcsr_create(work, template=ks_matrix, name='work', matrix_type=dbcsr_type_symmetric) 142 143 CALL dbcsr_copy(work, ks_matrix) 144 CALL dbcsr_set(work, 0.0_dp) 145 CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.) 146 147 CALL dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp) 148 149 CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.) 150 151 CALL dbcsr_set(work, 0.0_dp) 152 CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin)%matrix, work, keep_sparsity=.TRUE.) 153 154 CALL dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp) 155 CALL dbcsr_deallocate_matrix(work) 156 157 CASE (do_admm_purify_mo_diag) 158 NULLIFY (work) 159 ALLOCATE (work) 160 CALL dbcsr_create(work, template=ks_matrix, name='work', matrix_type=dbcsr_type_symmetric) 161 162 CALL dbcsr_copy(work, ks_matrix) 163 CALL dbcsr_set(work, 0.0_dp) 164 165 CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin)%matrix, work, keep_sparsity=.TRUE.) 166 167 CALL dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp) 168 CALL dbcsr_deallocate_matrix(work) 169 170 CASE (do_admm_purify_mo_no_diag, do_admm_purify_none, do_admm_purify_cauchy) 171 ! do nothing 172 END SELECT 173 ENDIF 174 END SUBROUTINE admm_uncorrect_for_eigenvalues 175 176END MODULE admm_utils 177