1#:include 'arnoldi.fypp'
2#:for nametype1, type_prec, real_zero, nametype_zero, type_nametype1, vartype in inst_params_1
3! **************************************************************************************************
4!> \brief ...
5!> \param arnoldi_data ...
6!> \param matrix ...
7!> \param max_iter ...
8! **************************************************************************************************
9  SUBROUTINE setup_arnoldi_data_${nametype1}$ (arnoldi_data, matrix, max_iter)
10    TYPE(arnoldi_data_type)                 :: arnoldi_data
11    TYPE(dbcsr_p_type), DIMENSION(:)     :: matrix
12    INTEGER                                 :: max_iter
13
14    CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_arnoldi_data_${nametype1}$', &
15      routineP = moduleN//':'//routineN
16
17    INTEGER                                           :: nrow_local
18    TYPE(arnoldi_data_${nametype1}$_type), POINTER      :: ar_data
19
20    ALLOCATE(ar_data)
21    CALL dbcsr_get_info(matrix=matrix(1)%matrix, nfullrows_local=nrow_local)
22    ALLOCATE(ar_data%f_vec(nrow_local))
23    ALLOCATE(ar_data%x_vec(nrow_local))
24    ALLOCATE(ar_data%Hessenberg(max_iter+1, max_iter))
25    ALLOCATE(ar_data%local_history(nrow_local, max_iter))
26
27    ALLOCATE(ar_data%evals(max_iter))
28    ALLOCATE(ar_data%revec(max_iter, max_iter))
29
30    CALL set_data_${nametype1}$(arnoldi_data,ar_data)
31
32  END SUBROUTINE setup_arnoldi_data_${nametype1}$
33
34! **************************************************************************************************
35!> \brief ...
36!> \param arnoldi_data ...
37! **************************************************************************************************
38  SUBROUTINE deallocate_arnoldi_data_${nametype1}$ (arnoldi_data)
39    TYPE(arnoldi_data_type)                     :: arnoldi_data
40
41    CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_arnoldi_data_${nametype1}$', &
42      routineP = moduleN//':'//routineN
43
44    TYPE(arnoldi_data_${nametype1}$_type), POINTER            :: ar_data
45
46    ar_data=>get_data_${nametype1}$(arnoldi_data)
47    IF(ASSOCIATED(ar_data%f_vec))DEALLOCATE(ar_data%f_vec)
48    IF(ASSOCIATED(ar_data%x_vec))DEALLOCATE(ar_data%x_vec)
49    IF(ASSOCIATED(ar_data%Hessenberg))DEALLOCATE(ar_data%Hessenberg)
50    IF(ASSOCIATED(ar_data%local_history))DEALLOCATE(ar_data%local_history)
51    IF(ASSOCIATED(ar_data%evals))DEALLOCATE(ar_data%evals)
52    IF(ASSOCIATED(ar_data%revec))DEALLOCATE(ar_data%revec)
53    DEALLOCATE(ar_data)
54
55  END SUBROUTINE deallocate_arnoldi_data_${nametype1}$
56
57! **************************************************************************************************
58!> \brief ...
59!> \param arnoldi_data ...
60!> \param ind ...
61!> \param matrix ...
62!> \param vector ...
63! **************************************************************************************************
64  SUBROUTINE get_selected_ritz_vector_${nametype1}$(arnoldi_data,ind,matrix,vector)
65    TYPE(arnoldi_data_type)                 :: arnoldi_data
66    INTEGER                                  :: ind
67    TYPE(dbcsr_type)                          :: matrix
68    TYPE(dbcsr_type)                          :: vector
69
70    CHARACTER(LEN=*), PARAMETER :: routineN = 'get_selected_ritz_vector_${nametype1}$', &
71      routineP = moduleN//':'//routineN
72
73    TYPE(arnoldi_data_${nametype1}$_type), POINTER      :: ar_data
74    INTEGER                                           :: vsize, myind, sspace_size, i
75    INTEGER, DIMENSION(:), POINTER           :: selected_ind
76    COMPLEX(${type_prec}$),DIMENSION(:),ALLOCATABLE       :: ritz_v
77    ${type_nametype1}$, DIMENSION(:), POINTER          :: data_vec
78    TYPE(arnoldi_control_type), POINTER           :: control
79
80    control=>get_control(arnoldi_data)
81    selected_ind=>get_sel_ind(arnoldi_data)
82    ar_data=>get_data_${nametype1}$(arnoldi_data)
83    sspace_size=get_subsp_size(arnoldi_data)
84    vsize=SIZE(ar_data%f_vec)
85    myind=selected_ind(ind)
86    ALLOCATE(ritz_v(vsize))
87    ritz_v=CMPLX(0.0,0.0,${type_prec}$)
88
89    CALL dbcsr_release(vector)
90    CALL create_col_vec_from_matrix(vector,matrix,1)
91    IF(control%local_comp)THEN
92       DO i=1,sspace_size
93          ritz_v(:)=ritz_v(:)+ar_data%local_history(:,i)*ar_data%revec(i,myind)
94       END DO
95       data_vec => dbcsr_get_data_p (vector, select_data_type=${nametype_zero}$)
96       ! is a bit odd but ritz_v is always complex and matrix type determines where it goes
97       ! again I hope the user knows what is required
98       data_vec(1:vsize) =${vartype}$(ritz_v(1:vsize),KIND=${type_prec}$)
99    END IF
100
101    DEALLOCATE(ritz_v)
102
103  END SUBROUTINE get_selected_ritz_vector_${nametype1}$
104
105
106! **************************************************************************************************
107!> \brief ...
108!> \param arnoldi_data ...
109!> \param vector ...
110! **************************************************************************************************
111  SUBROUTINE set_initial_vector_${nametype1}$(arnoldi_data,vector)
112    TYPE(arnoldi_data_type)                 :: arnoldi_data
113    TYPE(dbcsr_type)                          :: vector
114
115    CHARACTER(LEN=*), PARAMETER :: routineN = 'set_initial_vector_${nametype1}$', &
116      routineP = moduleN//':'//routineN
117
118    TYPE(arnoldi_data_${nametype1}$_type), POINTER     :: ar_data
119    ${type_nametype1}$, DIMENSION(:), POINTER          :: data_vec
120    INTEGER                                           :: nrow_local, ncol_local
121    TYPE(arnoldi_control_type), POINTER           :: control
122
123    control=>get_control(arnoldi_data)
124
125    CALL dbcsr_get_info(matrix=vector, nfullrows_local=nrow_local, nfullcols_local=ncol_local)
126    ar_data=>get_data_${nametype1}$(arnoldi_data)
127    data_vec => dbcsr_get_data_p (vector, select_data_type=${nametype_zero}$)
128    IF(nrow_local*ncol_local>0)ar_data%f_vec(1:nrow_local)=data_vec(1:nrow_local)
129
130  END SUBROUTINE set_initial_vector_${nametype1}$
131#:endfor
132