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