Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Front-End for any PAO parametrization
10 : !> \author Ole Schuett
11 : ! **************************************************************************************************
12 : MODULE pao_param
13 : USE cp_dbcsr_api, ONLY: dbcsr_copy,&
14 : dbcsr_frobenius_norm,&
15 : dbcsr_multiply,&
16 : dbcsr_release,&
17 : dbcsr_type
18 : USE dm_ls_scf_types, ONLY: ls_scf_env_type
19 : USE kinds, ONLY: dp
20 : USE pao_input, ONLY: pao_equi_param,&
21 : pao_exp_param,&
22 : pao_fock_param,&
23 : pao_gth_param,&
24 : pao_rotinv_param
25 : USE pao_param_equi, ONLY: pao_calc_AB_equi,&
26 : pao_param_count_equi,&
27 : pao_param_finalize_equi,&
28 : pao_param_init_equi,&
29 : pao_param_initguess_equi
30 : USE pao_param_exp, ONLY: pao_calc_AB_exp,&
31 : pao_param_count_exp,&
32 : pao_param_finalize_exp,&
33 : pao_param_init_exp,&
34 : pao_param_initguess_exp
35 : USE pao_param_gth, ONLY: pao_calc_AB_gth,&
36 : pao_param_count_gth,&
37 : pao_param_finalize_gth,&
38 : pao_param_init_gth,&
39 : pao_param_initguess_gth
40 : USE pao_param_linpot, ONLY: pao_calc_AB_linpot,&
41 : pao_param_count_linpot,&
42 : pao_param_finalize_linpot,&
43 : pao_param_init_linpot,&
44 : pao_param_initguess_linpot
45 : USE pao_types, ONLY: pao_env_type
46 : USE qs_environment_types, ONLY: qs_environment_type
47 : #include "./base/base_uses.f90"
48 :
49 : IMPLICIT NONE
50 :
51 : PRIVATE
52 :
53 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pao_param'
54 :
55 : PUBLIC :: pao_calc_AB, pao_param_count, pao_param_initial_guess
56 : PUBLIC :: pao_param_init, pao_param_finalize
57 :
58 : CONTAINS
59 :
60 : ! **************************************************************************************************
61 : !> \brief Takes current matrix_X and calculates the matrices A and B.
62 : !> \param pao ...
63 : !> \param qs_env ...
64 : !> \param ls_scf_env ...
65 : !> \param gradient ...
66 : !> \param penalty ...
67 : !> \param forces ...
68 : ! **************************************************************************************************
69 14758 : SUBROUTINE pao_calc_AB(pao, qs_env, ls_scf_env, gradient, penalty, forces)
70 : TYPE(pao_env_type), POINTER :: pao
71 : TYPE(qs_environment_type), POINTER :: qs_env
72 : TYPE(ls_scf_env_type), TARGET :: ls_scf_env
73 : LOGICAL, INTENT(IN) :: gradient
74 : REAL(dp), INTENT(OUT), OPTIONAL :: penalty
75 : REAL(dp), DIMENSION(:, :), INTENT(OUT), OPTIONAL :: forces
76 :
77 : CHARACTER(len=*), PARAMETER :: routineN = 'pao_calc_AB'
78 :
79 : INTEGER :: handle
80 :
81 14758 : CALL timeset(routineN, handle)
82 :
83 14758 : IF (PRESENT(penalty)) penalty = 0.0_dp
84 15208 : IF (PRESENT(forces)) forces(:, :) = 0.0_dp
85 :
86 : !calculate matrix_A/B = Function of matrix_X
87 17468 : SELECT CASE (pao%parameterization)
88 : CASE (pao_exp_param)
89 2710 : CALL pao_calc_AB_exp(pao, qs_env, ls_scf_env, gradient)
90 : CASE (pao_fock_param, pao_rotinv_param)
91 16382 : CALL pao_calc_AB_linpot(pao, qs_env, ls_scf_env, gradient, penalty, forces)
92 : CASE (pao_gth_param)
93 2152 : CALL pao_calc_AB_gth(pao, qs_env, ls_scf_env, gradient, penalty)
94 : CASE (pao_equi_param)
95 1688 : CALL pao_calc_AB_equi(pao, qs_env, ls_scf_env, gradient, penalty)
96 : CASE DEFAULT
97 14758 : CPABORT("PAO: unkown parametrization")
98 : END SELECT
99 :
100 14758 : CALL timestop(handle)
101 14758 : END SUBROUTINE pao_calc_AB
102 :
103 : ! **************************************************************************************************
104 : !> \brief Initialize PAO parametrization
105 : !> \param pao ...
106 : !> \param qs_env ...
107 : ! **************************************************************************************************
108 278 : SUBROUTINE pao_param_init(pao, qs_env)
109 : TYPE(pao_env_type), POINTER :: pao
110 : TYPE(qs_environment_type), POINTER :: qs_env
111 :
112 : CHARACTER(len=*), PARAMETER :: routineN = 'pao_param_init'
113 :
114 : INTEGER :: handle
115 :
116 278 : CALL timeset(routineN, handle)
117 :
118 302 : SELECT CASE (pao%parameterization)
119 : CASE (pao_exp_param)
120 24 : CALL pao_param_init_exp(pao, qs_env)
121 : CASE (pao_fock_param, pao_rotinv_param)
122 234 : CALL pao_param_init_linpot(pao, qs_env)
123 : CASE (pao_gth_param)
124 10 : CALL pao_param_init_gth(pao, qs_env)
125 : CASE (pao_equi_param)
126 10 : CALL pao_param_init_equi(pao)
127 : CASE DEFAULT
128 278 : CPABORT("PAO: unknown parametrization")
129 : END SELECT
130 :
131 278 : CALL timestop(handle)
132 :
133 278 : END SUBROUTINE pao_param_init
134 :
135 : ! **************************************************************************************************
136 : !> \brief Finalize PAO parametrization
137 : !> \param pao ...
138 : ! **************************************************************************************************
139 278 : SUBROUTINE pao_param_finalize(pao)
140 : TYPE(pao_env_type), POINTER :: pao
141 :
142 : CHARACTER(len=*), PARAMETER :: routineN = 'pao_param_finalize'
143 :
144 : INTEGER :: handle
145 :
146 278 : CALL timeset(routineN, handle)
147 :
148 302 : SELECT CASE (pao%parameterization)
149 : CASE (pao_exp_param)
150 24 : CALL pao_param_finalize_exp(pao)
151 : CASE (pao_fock_param, pao_rotinv_param)
152 234 : CALL pao_param_finalize_linpot(pao)
153 : CASE (pao_gth_param)
154 10 : CALL pao_param_finalize_gth(pao)
155 : CASE (pao_equi_param)
156 10 : CALL pao_param_finalize_equi()
157 : CASE DEFAULT
158 278 : CPABORT("PAO: unknown parametrization")
159 : END SELECT
160 :
161 278 : CALL timestop(handle)
162 :
163 278 : END SUBROUTINE pao_param_finalize
164 :
165 : ! **************************************************************************************************
166 : !> \brief Returns the number of parameters for given atomic kind
167 : !> \param pao ...
168 : !> \param qs_env ...
169 : !> \param ikind ...
170 : !> \param nparams ...
171 : ! **************************************************************************************************
172 310 : SUBROUTINE pao_param_count(pao, qs_env, ikind, nparams)
173 : TYPE(pao_env_type), POINTER :: pao
174 : TYPE(qs_environment_type), POINTER :: qs_env
175 : INTEGER, INTENT(IN) :: ikind
176 : INTEGER, INTENT(OUT) :: nparams
177 :
178 : CHARACTER(len=*), PARAMETER :: routineN = 'pao_param_count'
179 :
180 : INTEGER :: handle
181 :
182 310 : CALL timeset(routineN, handle)
183 :
184 374 : SELECT CASE (pao%parameterization)
185 : CASE (pao_exp_param)
186 256 : CALL pao_param_count_exp(qs_env, ikind=ikind, nparams=nparams)
187 : CASE (pao_fock_param, pao_rotinv_param)
188 214 : CALL pao_param_count_linpot(pao, qs_env, ikind=ikind, nparams=nparams)
189 : CASE (pao_gth_param)
190 54 : CALL pao_param_count_gth(qs_env, ikind=ikind, nparams=nparams)
191 : CASE (pao_equi_param)
192 32 : CALL pao_param_count_equi(qs_env, ikind=ikind, nparams=nparams)
193 : CASE DEFAULT
194 310 : CPABORT("PAO: unknown parametrization")
195 : END SELECT
196 :
197 310 : CALL timestop(handle)
198 :
199 310 : END SUBROUTINE pao_param_count
200 :
201 : ! **************************************************************************************************
202 : !> \brief Fills matrix_X with an initial guess
203 : !> \param pao ...
204 : !> \param qs_env ...
205 : ! **************************************************************************************************
206 68 : SUBROUTINE pao_param_initial_guess(pao, qs_env)
207 : TYPE(pao_env_type), POINTER :: pao
208 : TYPE(qs_environment_type), POINTER :: qs_env
209 :
210 : CHARACTER(len=*), PARAMETER :: routineN = 'pao_param_initial_guess'
211 :
212 : INTEGER :: handle
213 : REAL(dp) :: norm
214 : TYPE(dbcsr_type) :: matrix_tmp
215 :
216 68 : CALL timeset(routineN, handle)
217 :
218 82 : SELECT CASE (pao%parameterization)
219 : CASE (pao_exp_param)
220 14 : CALL pao_param_initguess_exp(pao)
221 : CASE (pao_fock_param, pao_rotinv_param)
222 34 : CALL pao_param_initguess_linpot(pao, qs_env)
223 : CASE (pao_gth_param)
224 10 : CALL pao_param_initguess_gth(pao)
225 : CASE (pao_equi_param)
226 10 : CALL pao_param_initguess_equi(pao, qs_env)
227 : CASE DEFAULT
228 68 : CPABORT("PAO: unknown parametrization")
229 : END SELECT
230 :
231 68 : norm = dbcsr_frobenius_norm(pao%matrix_X)
232 68 : IF (pao%iw > 0) WRITE (pao%iw, *) "PAO| Made initial guess for matrix_X with norm:", norm
233 :
234 68 : IF (pao%precondition) THEN
235 : !TODO: multiplying a matrix into itself while retaining sparsity seems to be broken
236 16 : CALL dbcsr_copy(matrix_tmp, pao%matrix_X)
237 : CALL dbcsr_multiply("N", "N", 1.0_dp, pao%matrix_precon, matrix_tmp, &
238 16 : 0.0_dp, pao%matrix_X, retain_sparsity=.TRUE.)
239 16 : CALL dbcsr_release(matrix_tmp)
240 : END IF
241 :
242 68 : CALL timestop(handle)
243 :
244 68 : END SUBROUTINE pao_param_initial_guess
245 :
246 : END MODULE pao_param
|