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 collection of types used in arnoldi
10 : !> \par History
11 : !> 2014.09 created [Florian Schiffmann]
12 : !> \author Florian Schiffmann
13 : ! **************************************************************************************************
14 :
15 : MODULE arnoldi_types
16 : USE cp_dbcsr_api, ONLY: dbcsr_type
17 : USE kinds, ONLY: real_4,&
18 : real_8
19 : USE message_passing, ONLY: mp_comm_type
20 :
21 : IMPLICIT NONE
22 :
23 : ! Type that gets created during the arnoldi procedure and contains basically everything
24 : ! As it is not quite clear what the user will request, this is the most general way to satisfy all needs:
25 : ! Give him everything we have and create some easy to use routines to post process externally
26 : TYPE arnoldi_control_type
27 : LOGICAL :: local_comp = .FALSE., converged = .FALSE.
28 : INTEGER :: myproc = -1
29 : TYPE(mp_comm_type) :: mp_group = mp_comm_type(), pcol_group = mp_comm_type()
30 : INTEGER :: max_iter = -1 ! Maximum number of iterations
31 : INTEGER :: current_step = -1 ! In case subspace converged early contains last iteration
32 : INTEGER :: nval_req = -1
33 : INTEGER :: selection_crit = -1
34 : INTEGER :: nval_out = -1
35 : INTEGER :: nrestart = -1
36 : REAL(real_8) :: threshold = 0.0_real_8
37 : LOGICAL :: symmetric = .FALSE.
38 : LOGICAL :: generalized_ev = .FALSE.
39 : LOGICAL :: iram = .FALSE.
40 : LOGICAL :: has_initial_vector = .FALSE.
41 : INTEGER, DIMENSION(:), POINTER :: selected_ind => NULL() ! list of indices matching the selection criterion
42 : END TYPE arnoldi_control_type
43 :
44 : TYPE arnoldi_data_d_type
45 : REAL(kind=real_8), POINTER, DIMENSION(:) :: f_vec => NULL() ! the local parts of the residual vector
46 : REAL(kind=real_8), POINTER, DIMENSION(:, :) :: Hessenberg => NULL() ! the Hessenberg matrix
47 : REAL(kind=real_8), POINTER, DIMENSION(:, :) :: local_history => NULL() ! the complete set of orthonormal vectors (local part)
48 : COMPLEX(real_8), POINTER, DIMENSION(:) :: evals => NULL() ! the real part of the eigenvalues (if complex both)
49 : COMPLEX(real_8), POINTER, DIMENSION(:, :) :: revec => NULL() ! the right eigenvectors
50 : REAL(kind=real_8) :: rho_scale = 0.0_real_8 ! scling factor for general eig arnoldi
51 : REAL(kind=real_8), POINTER, DIMENSION(:) :: x_vec => NULL() ! eigenvector for genreal eig arnoldi
52 : END TYPE arnoldi_data_d_type
53 :
54 : TYPE arnoldi_data_s_type
55 : REAL(kind=real_4), POINTER, DIMENSION(:) :: f_vec => NULL() ! the local parts of the residual vector
56 : REAL(kind=real_4), POINTER, DIMENSION(:, :) :: Hessenberg => NULL() ! the Hessenberg matrix
57 : REAL(kind=real_4), POINTER, DIMENSION(:, :) :: local_history => NULL() ! the complete set of orthonormal vectors (local part)
58 : COMPLEX(real_4), POINTER, DIMENSION(:) :: evals => NULL() ! the real part of the eigenvalues (if complex both)
59 : COMPLEX(real_4), POINTER, DIMENSION(:, :) :: revec => NULL() ! the right eigenvectors
60 : REAL(kind=real_4) :: rho_scale = 0.0_real_4 ! scling factor for general eig arnoldi
61 : REAL(kind=real_4), POINTER, DIMENSION(:) :: x_vec => NULL() ! eigenvector for genreal eig arnoldi
62 : END TYPE arnoldi_data_s_type
63 :
64 : TYPE arnoldi_data_z_type
65 : COMPLEX(kind=real_8), POINTER, DIMENSION(:) :: f_vec => NULL() ! the local parts of the residual vector
66 : COMPLEX(kind=real_8), POINTER, DIMENSION(:, :) :: Hessenberg => NULL() ! the Hessenberg matrix
67 : COMPLEX(kind=real_8), POINTER, DIMENSION(:, :) :: local_history => NULL() ! the complete set of orthonormal vectors (local part)
68 : COMPLEX(real_8), POINTER, DIMENSION(:) :: evals => NULL() ! the real part of the eigenvalues (if complex both)
69 : COMPLEX(real_8), POINTER, DIMENSION(:, :) :: revec => NULL() ! the right eigenvectors
70 : COMPLEX(kind=real_8) :: rho_scale = (0.0_real_8, 0.0_real_8) ! scling factor for general eig arnoldi
71 : COMPLEX(kind=real_8), POINTER, DIMENSION(:) :: x_vec => NULL() ! eigenvector for genreal eig arnoldi
72 : END TYPE arnoldi_data_z_type
73 :
74 : TYPE arnoldi_data_c_type
75 : COMPLEX(kind=real_4), POINTER, DIMENSION(:) :: f_vec => NULL() ! the local parts of the residual vector
76 : COMPLEX(kind=real_4), POINTER, DIMENSION(:, :) :: Hessenberg => NULL() ! the Hessenberg matrix
77 : COMPLEX(kind=real_4), POINTER, DIMENSION(:, :) :: local_history => NULL() ! the complete set of orthonormal vectors (local part)
78 : COMPLEX(real_4), POINTER, DIMENSION(:) :: evals => NULL() ! the real part of the eigenvalues (if complex both)
79 : COMPLEX(real_4), POINTER, DIMENSION(:, :) :: revec => NULL() ! the right eigenvectors
80 : COMPLEX(kind=real_4) :: rho_scale = (0.0_real_4, 0.0_real_4) ! scling factor for general eig arnoldi
81 : COMPLEX(kind=real_4), POINTER, DIMENSION(:) :: x_vec => NULL() ! eigenvector for genreal eig arnoldi
82 : END TYPE arnoldi_data_c_type
83 :
84 : TYPE arnoldi_data_type
85 : TYPE(arnoldi_data_s_type), POINTER, PRIVATE :: data_s => NULL()
86 : TYPE(arnoldi_data_d_type), POINTER, PRIVATE :: data_d => NULL()
87 : TYPE(arnoldi_data_c_type), POINTER, PRIVATE :: data_c => NULL()
88 : TYPE(arnoldi_data_z_type), POINTER, PRIVATE :: data_z => NULL()
89 : TYPE(arnoldi_control_type), POINTER, PRIVATE :: control => NULL()
90 : END TYPE arnoldi_data_type
91 :
92 : TYPE m_x_v_vectors_type
93 : TYPE(dbcsr_type) :: input_vec
94 : TYPE(dbcsr_type) :: result_vec
95 : TYPE(dbcsr_type) :: rep_col_vec
96 : TYPE(dbcsr_type) :: rep_row_vec
97 : END TYPE m_x_v_vectors_type
98 :
99 : PRIVATE
100 :
101 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'arnoldi_types'
102 :
103 : PUBLIC :: arnoldi_data_type, m_x_v_vectors_type, get_data_d, get_data_s, get_sel_ind, &
104 : get_data_z, get_data_c, get_control, has_s_real, has_d_real, arnoldi_control_type, &
105 : has_s_cmplx, has_d_cmplx, arnoldi_data_d_type, arnoldi_data_s_type, arnoldi_data_z_type, arnoldi_data_c_type, &
106 : get_evals_d, get_evals_c, get_evals_z, get_evals_s, set_control, set_data_d, set_data_s, &
107 : set_data_z, set_data_c
108 : CONTAINS
109 :
110 : ! **************************************************************************************************
111 : !> \brief ...
112 : !> \param ar_data ...
113 : !> \param control ...
114 : ! **************************************************************************************************
115 130233 : SUBROUTINE set_control(ar_data, control)
116 : TYPE(arnoldi_data_type), INTENT(INOUT) :: ar_data
117 : TYPE(arnoldi_control_type), INTENT(IN), POINTER :: control
118 :
119 130233 : ar_data%control => control
120 130233 : END SUBROUTINE set_control
121 :
122 : ! **************************************************************************************************
123 : !> \brief ...
124 : !> \param ar_data ...
125 : !> \return ...
126 : ! **************************************************************************************************
127 386737 : FUNCTION get_sel_ind(ar_data) RESULT(selected_ind)
128 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
129 : INTEGER, DIMENSION(:), POINTER :: selected_ind
130 :
131 386737 : selected_ind => ar_data%control%selected_ind
132 :
133 386737 : END FUNCTION get_sel_ind
134 :
135 : ! **************************************************************************************************
136 : !> \brief ...
137 : !> \param ar_data ...
138 : !> \return ...
139 : ! **************************************************************************************************
140 798368 : FUNCTION get_data_d(ar_data) RESULT(data_d)
141 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
142 : TYPE(arnoldi_data_d_type), POINTER :: data_d
143 :
144 798368 : data_d => ar_data%data_d
145 :
146 798368 : END FUNCTION get_data_d
147 :
148 : ! **************************************************************************************************
149 : !> \brief ...
150 : !> \param ar_data ...
151 : !> \return ...
152 : ! **************************************************************************************************
153 0 : FUNCTION get_data_s(ar_data) RESULT(data_s)
154 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
155 : TYPE(arnoldi_data_s_type), POINTER :: data_s
156 :
157 0 : data_s => ar_data%data_s
158 :
159 0 : END FUNCTION get_data_s
160 :
161 : ! **************************************************************************************************
162 : !> \brief ...
163 : !> \param ar_data ...
164 : !> \return ...
165 : ! **************************************************************************************************
166 0 : FUNCTION get_data_z(ar_data) RESULT(data_z)
167 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
168 : TYPE(arnoldi_data_z_type), POINTER :: data_z
169 :
170 0 : data_z => ar_data%data_z
171 :
172 0 : END FUNCTION get_data_z
173 :
174 : ! **************************************************************************************************
175 : !> \brief ...
176 : !> \param ar_data ...
177 : !> \return ...
178 : ! **************************************************************************************************
179 0 : FUNCTION get_data_c(ar_data) RESULT(data_c)
180 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
181 : TYPE(arnoldi_data_c_type), POINTER :: data_c
182 :
183 0 : data_c => ar_data%data_c
184 :
185 0 : END FUNCTION get_data_c
186 :
187 : ! **************************************************************************************************
188 : !> \brief ...
189 : !> \param ar_data ...
190 : !> \param data_d ...
191 : ! **************************************************************************************************
192 130233 : SUBROUTINE set_data_d(ar_data, data_d)
193 : TYPE(arnoldi_data_type), INTENT(INOUT) :: ar_data
194 : TYPE(arnoldi_data_d_type), INTENT(IN), POINTER :: data_d
195 :
196 130233 : ar_data%data_d => data_d
197 :
198 130233 : END SUBROUTINE set_data_d
199 :
200 : ! **************************************************************************************************
201 : !> \brief ...
202 : !> \param ar_data ...
203 : !> \param data_s ...
204 : ! **************************************************************************************************
205 0 : SUBROUTINE set_data_s(ar_data, data_s)
206 : TYPE(arnoldi_data_type), INTENT(INOUT) :: ar_data
207 : TYPE(arnoldi_data_s_type), INTENT(IN), POINTER :: data_s
208 :
209 0 : ar_data%data_s => data_s
210 :
211 0 : END SUBROUTINE set_data_s
212 :
213 : ! **************************************************************************************************
214 : !> \brief ...
215 : !> \param ar_data ...
216 : !> \param data_c ...
217 : ! **************************************************************************************************
218 0 : SUBROUTINE set_data_c(ar_data, data_c)
219 : TYPE(arnoldi_data_type), INTENT(INOUT) :: ar_data
220 : TYPE(arnoldi_data_c_type), INTENT(IN), POINTER :: data_c
221 :
222 0 : ar_data%data_c => data_c
223 :
224 0 : END SUBROUTINE set_data_c
225 :
226 : ! **************************************************************************************************
227 : !> \brief ...
228 : !> \param ar_data ...
229 : !> \param data_z ...
230 : ! **************************************************************************************************
231 0 : SUBROUTINE set_data_z(ar_data, data_z)
232 : TYPE(arnoldi_data_type), INTENT(INOUT) :: ar_data
233 : TYPE(arnoldi_data_z_type), INTENT(IN), POINTER :: data_z
234 :
235 0 : ar_data%data_z => data_z
236 :
237 0 : END SUBROUTINE set_data_z
238 :
239 : ! **************************************************************************************************
240 : !> \brief ...
241 : !> \param ar_data ...
242 : !> \return ...
243 : ! **************************************************************************************************
244 1702529 : FUNCTION get_control(ar_data) RESULT(control)
245 : TYPE(arnoldi_data_type), INTENT(INOUT) :: ar_data
246 : TYPE(arnoldi_control_type), POINTER :: control
247 :
248 1702529 : control => ar_data%control
249 :
250 1702529 : END FUNCTION get_control
251 :
252 : ! **************************************************************************************************
253 : !> \brief ...
254 : !> \param ar_data ...
255 : !> \return ...
256 : ! **************************************************************************************************
257 1050364 : FUNCTION has_d_real(ar_data) RESULT(is_present)
258 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
259 : LOGICAL :: is_present
260 :
261 1050364 : is_present = ASSOCIATED(ar_data%data_d)
262 :
263 1050364 : END FUNCTION has_d_real
264 :
265 : ! **************************************************************************************************
266 : !> \brief ...
267 : !> \param ar_data ...
268 : !> \return ...
269 : ! **************************************************************************************************
270 0 : ELEMENTAL FUNCTION has_s_real(ar_data) RESULT(is_present)
271 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
272 : LOGICAL :: is_present
273 :
274 0 : is_present = ASSOCIATED(ar_data%data_s)
275 :
276 0 : END FUNCTION has_s_real
277 :
278 : ! **************************************************************************************************
279 : !> \brief ...
280 : !> \param ar_data ...
281 : !> \return ...
282 : ! **************************************************************************************************
283 798368 : ELEMENTAL FUNCTION has_d_cmplx(ar_data) RESULT(is_present)
284 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
285 : LOGICAL :: is_present
286 :
287 798368 : is_present = ASSOCIATED(ar_data%data_z)
288 :
289 798368 : END FUNCTION has_d_cmplx
290 :
291 : ! **************************************************************************************************
292 : !> \brief ...
293 : !> \param ar_data ...
294 : !> \return ...
295 : ! **************************************************************************************************
296 0 : ELEMENTAL FUNCTION has_s_cmplx(ar_data) RESULT(is_present)
297 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
298 : LOGICAL :: is_present
299 :
300 0 : is_present = ASSOCIATED(ar_data%data_c)
301 :
302 0 : END FUNCTION has_s_cmplx
303 :
304 : ! **************************************************************************************************
305 : !> \brief ...
306 : !> \param ar_data ...
307 : !> \return ...
308 : ! **************************************************************************************************
309 251996 : FUNCTION get_evals_d(ar_data) RESULT(evals)
310 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
311 : COMPLEX(real_8), DIMENSION(:), POINTER :: evals
312 :
313 251996 : evals => ar_data%data_d%evals
314 :
315 251996 : END FUNCTION get_evals_d
316 :
317 : ! **************************************************************************************************
318 : !> \brief ...
319 : !> \param ar_data ...
320 : !> \return ...
321 : ! **************************************************************************************************
322 0 : FUNCTION get_evals_s(ar_data) RESULT(evals)
323 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
324 : COMPLEX(real_4), DIMENSION(:), POINTER :: evals
325 :
326 0 : evals => ar_data%data_s%evals
327 :
328 0 : END FUNCTION get_evals_s
329 :
330 : ! **************************************************************************************************
331 : !> \brief ...
332 : !> \param ar_data ...
333 : !> \return ...
334 : ! **************************************************************************************************
335 0 : FUNCTION get_evals_z(ar_data) RESULT(evals)
336 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
337 : COMPLEX(real_8), DIMENSION(:), POINTER :: evals
338 :
339 0 : evals => ar_data%data_z%evals
340 :
341 0 : END FUNCTION get_evals_z
342 :
343 : ! **************************************************************************************************
344 : !> \brief ...
345 : !> \param ar_data ...
346 : !> \return ...
347 : ! **************************************************************************************************
348 0 : FUNCTION get_evals_c(ar_data) RESULT(evals)
349 : TYPE(arnoldi_data_type), INTENT(IN) :: ar_data
350 : COMPLEX(real_4), DIMENSION(:), POINTER :: evals
351 :
352 0 : evals => ar_data%data_c%evals
353 :
354 0 : END FUNCTION get_evals_c
355 :
356 0 : END MODULE arnoldi_types
|