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