libflame revision_anchor
Functions
FLA_Hevdr_external.c File Reference

(r)

Functions

FLA_Error FLA_Hevdr_external (FLA_Evd_type jobz, FLA_Uplo uplo, FLA_Obj A, FLA_Obj l, FLA_Obj Z)
 

Function Documentation

◆ FLA_Hevdr_external()

FLA_Error FLA_Hevdr_external ( FLA_Evd_type jobz,
FLA_Uplo uplo,
FLA_Obj A,
FLA_Obj l,
FLA_Obj Z )
14{
15 int info = 0;
16#ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES
17 FLA_Datatype datatype;
18 FLA_Datatype dt_real;
19 int n_A, cs_A;
20 int cs_Z;
21 int lwork, lrwork, liwork, lisuppz;
22 FLA_Obj work, rwork, iwork, isuppz, abstol;
23 char blas_jobz;
24 char blas_uplo;
25 int i;
26
27 char blas_range = 'A';
28 int il, iu;
29 int eigs_found;
30
31 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
32 FLA_Hevdr_check( jobz, uplo, A, l, Z );
33
34 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
35
36 datatype = FLA_Obj_datatype( A );
37 dt_real = FLA_Obj_datatype_proj_to_real( A );
38
39 n_A = FLA_Obj_width( A );
40 cs_A = FLA_Obj_col_stride( A );
41 cs_Z = FLA_Obj_col_stride( Z );
42
43 FLA_Param_map_flame_to_netlib_evd_type( jobz, &blas_jobz );
44 FLA_Param_map_flame_to_netlib_uplo( uplo, &blas_uplo );
45
46 lisuppz = 2 * n_A;
47 FLA_Obj_create( FLA_INT, lisuppz, 1, 0, 0, &isuppz );
48 FLA_Obj_create( dt_real, 1, 1, 0, 0, &abstol );
49
50 // Query the safe minimum to use as the abstol parameter.
51 FLA_Mach_params( FLA_MACH_SFMIN, abstol );
52
53 // Make a workspace query the first time through. This will provide us with
54 // and ideal workspace size.
55 lwork = -1;
56 lrwork = -1;
57 liwork = -1;
58 FLA_Obj_create( datatype, 1, 1, 0, 0, &work );
59 FLA_Obj_create( dt_real, 1, 1, 0, 0, &rwork );
60 FLA_Obj_create( FLA_INT, 1, 1, 0, 0, &iwork );
61
62 for ( i = 0; i < 2; ++i )
63 {
64 if ( i == 1 )
65 {
66 // Grab the queried ideal workspace size from the work arrays, free the
67 // work object, and then re-allocate the workspace with the ideal size.
68 if ( datatype == FLA_FLOAT || datatype == FLA_COMPLEX )
69 {
70 lwork = ( int ) *FLA_FLOAT_PTR( work );
71 lrwork = ( int ) *FLA_FLOAT_PTR( rwork );
72 liwork = ( int ) *FLA_INT_PTR( iwork );
73 }
74 else if ( datatype == FLA_DOUBLE || datatype == FLA_DOUBLE_COMPLEX )
75 {
76 lwork = ( int ) *FLA_DOUBLE_PTR( work );
77 lrwork = ( int ) *FLA_DOUBLE_PTR( rwork );
78 liwork = ( int ) *FLA_INT_PTR( iwork );
79 }
80
81 FLA_Obj_free( &work );
82 FLA_Obj_free( &iwork );
83 FLA_Obj_free( &rwork );
84 FLA_Obj_create( datatype, lwork, 1, 0, 0, &work );
85 FLA_Obj_create( FLA_INT, liwork, 1, 0, 0, &iwork );
86 if ( FLA_Obj_is_complex( A ) )
87 FLA_Obj_create( dt_real, lrwork, 1, 0, 0, &rwork );
88 }
89
90 switch( datatype ) {
91
92 case FLA_FLOAT:
93 {
94 float* buff_A = ( float* ) FLA_FLOAT_PTR( A );
95 float* buff_l = ( float* ) FLA_FLOAT_PTR( l );
96 float* buff_Z = ( float* ) FLA_FLOAT_PTR( Z );
97 float* buff_work = ( float* ) FLA_FLOAT_PTR( work );
98 float* buff_abstol = ( float* ) FLA_FLOAT_PTR( abstol );
99 int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
100 int* buff_isuppz = ( int* ) FLA_INT_PTR( isuppz );
101 float vl, vu;
102
103 F77_ssyevr( &blas_jobz,
104 &blas_range,
105 &blas_uplo,
106 &n_A,
107 buff_A, &cs_A,
108 &vl, &vu,
109 &il, &iu,
110 buff_abstol,
111 &eigs_found,
112 buff_l,
113 buff_Z, &cs_Z,
114 buff_isuppz,
115 buff_work, &lwork,
116 buff_iwork, &liwork,
117 &info );
118 break;
119 }
120
121 case FLA_DOUBLE:
122 {
123 double* buff_A = ( double* ) FLA_DOUBLE_PTR( A );
124 double* buff_l = ( double* ) FLA_DOUBLE_PTR( l );
125 double* buff_Z = ( double* ) FLA_DOUBLE_PTR( Z );
126 double* buff_work = ( double* ) FLA_DOUBLE_PTR( work );
127 double* buff_abstol = ( double* ) FLA_DOUBLE_PTR( abstol );
128 int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
129 int* buff_isuppz = ( int* ) FLA_INT_PTR( isuppz );
130 double vl, vu;
131
132 F77_dsyevr( &blas_jobz,
133 &blas_range,
134 &blas_uplo,
135 &n_A,
136 buff_A, &cs_A,
137 &vl, &vu,
138 &il, &iu,
139 buff_abstol,
140 &eigs_found,
141 buff_l,
142 buff_Z, &cs_Z,
143 buff_isuppz,
144 buff_work, &lwork,
145 buff_iwork, &liwork,
146 &info );
147 break;
148 }
149
150 case FLA_COMPLEX:
151 {
152 scomplex* buff_A = ( scomplex* ) FLA_COMPLEX_PTR( A );
153 float* buff_l = ( float* ) FLA_FLOAT_PTR( l );
154 scomplex* buff_Z = ( scomplex* ) FLA_COMPLEX_PTR( Z );
155 scomplex* buff_work = ( scomplex* ) FLA_COMPLEX_PTR( work );
156 float* buff_rwork = ( float* ) FLA_FLOAT_PTR( rwork );
157 float* buff_abstol = ( float* ) FLA_FLOAT_PTR( abstol );
158 int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
159 int* buff_isuppz = ( int* ) FLA_INT_PTR( isuppz );
160 float vl, vu;
161
162 F77_cheevr( &blas_jobz,
163 &blas_range,
164 &blas_uplo,
165 &n_A,
166 buff_A, &cs_A,
167 &vl, &vu,
168 &il, &iu,
169 buff_abstol,
170 &eigs_found,
171 buff_l,
172 buff_Z, &cs_Z,
173 buff_isuppz,
174 buff_work, &lwork,
175 buff_rwork, &lrwork,
176 buff_iwork, &liwork,
177 &info );
178 break;
179 }
180
181 case FLA_DOUBLE_COMPLEX:
182 {
183 dcomplex* buff_A = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( A );
184 double* buff_l = ( double* ) FLA_DOUBLE_PTR( l );
185 dcomplex* buff_Z = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( Z );
186 dcomplex* buff_work = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( work );
187 double* buff_rwork = ( double* ) FLA_DOUBLE_PTR( rwork );
188 double* buff_abstol = ( double* ) FLA_DOUBLE_PTR( abstol );
189 int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
190 int* buff_isuppz = ( int* ) FLA_INT_PTR( isuppz );
191 double vl, vu;
192
193 F77_zheevr( &blas_jobz,
194 &blas_range,
195 &blas_uplo,
196 &n_A,
197 buff_A, &cs_A,
198 &vl, &vu,
199 &il, &iu,
200 buff_abstol,
201 &eigs_found,
202 buff_l,
203 buff_Z, &cs_Z,
204 buff_isuppz,
205 buff_work, &lwork,
206 buff_rwork, &lrwork,
207 buff_iwork, &liwork,
208 &info );
209 break;
210 }
211
212 }
213 }
214
215 FLA_Obj_free( &work );
216 FLA_Obj_free( &iwork );
217 FLA_Obj_free( &isuppz );
218 FLA_Obj_free( &abstol );
219 if ( FLA_Obj_is_complex( A ) )
220 FLA_Obj_free( &rwork );
221#else
222 FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
223#endif
224
225 return info;
226}
FLA_Hevdr_check
FLA_Error FLA_Hevdr_check(FLA_Evd_type jobz, FLA_Uplo uplo, FLA_Obj A, FLA_Obj l, FLA_Obj Z)
Definition FLA_Hevdr_check.c:13
F77_zheevr
int F77_zheevr(char *jobz, char *range, char *uplo, int *n, dcomplex *a, int *lda, double *vl, double *vu, int *il, int *iu, double *abstol, int *m, double *w, dcomplex *z, int *ldz, int *isuppz, dcomplex *work, int *lwork, double *rwork, int *lrwork, int *iwork, int *liwork, int *info)
F77_dsyevr
int F77_dsyevr(char *jobz, char *range, char *uplo, int *n, double *a, int *lda, double *vl, double *vu, int *il, int *iu, double *abstol, int *m, double *w, double *z, int *ldz, int *isuppz, double *work, int *lwork, int *iwork, int *liwork, int *info)
F77_ssyevr
int F77_ssyevr(char *jobz, char *range, char *uplo, int *n, float *a, int *lda, float *vl, float *vu, int *il, int *iu, float *abstol, int *m, float *w, float *z, int *ldz, int *isuppz, float *work, int *lwork, int *iwork, int *liwork, int *info)
F77_cheevr
int F77_cheevr(char *jobz, char *range, char *uplo, int *n, scomplex *a, int *lda, float *vl, float *vu, int *il, int *iu, float *abstol, int *m, float *w, scomplex *z, int *ldz, int *isuppz, scomplex *work, int *lwork, float *rwork, int *lrwork, int *iwork, int *liwork, int *info)
FLA_Param_map_flame_to_netlib_evd_type
void FLA_Param_map_flame_to_netlib_evd_type(FLA_Evd_type evd_type, void *lapack_evd_type)
Definition FLA_Param.c:151
FLA_Obj_width
dim_t FLA_Obj_width(FLA_Obj obj)
Definition FLA_Query.c:123
FLA_Obj_create
FLA_Error FLA_Obj_create(FLA_Datatype datatype, dim_t m, dim_t n, dim_t rs, dim_t cs, FLA_Obj *obj)
Definition FLA_Obj.c:55
FLA_Obj_has_zero_dim
FLA_Bool FLA_Obj_has_zero_dim(FLA_Obj A)
Definition FLA_Query.c:400
FLA_Obj_datatype_proj_to_real
FLA_Datatype FLA_Obj_datatype_proj_to_real(FLA_Obj A)
Definition FLA_Query.c:23
FLA_Obj_is_complex
FLA_Bool FLA_Obj_is_complex(FLA_Obj A)
Definition FLA_Query.c:324
FLA_Obj_col_stride
dim_t FLA_Obj_col_stride(FLA_Obj obj)
Definition FLA_Query.c:174
FLA_Check_error_level
unsigned int FLA_Check_error_level(void)
Definition FLA_Check.c:18
FLA_Obj_free
FLA_Error FLA_Obj_free(FLA_Obj *obj)
Definition FLA_Obj.c:588
FLA_Param_map_flame_to_netlib_uplo
void FLA_Param_map_flame_to_netlib_uplo(FLA_Uplo uplo, void *blas_uplo)
Definition FLA_Param.c:47
FLA_Obj_datatype
FLA_Datatype FLA_Obj_datatype(FLA_Obj obj)
Definition FLA_Query.c:13
FLA_Datatype
int FLA_Datatype
Definition FLA_type_defs.h:49
FLA_Mach_params
FLA_Error FLA_Mach_params(FLA_Machval machval, FLA_Obj val)
Definition FLA_Mach_params.c:13
i
int i
Definition bl1_axmyv2.c:145
FLA_Obj_view
Definition FLA_type_defs.h:159
dcomplex
Definition blis_type_defs.h:138
scomplex
Definition blis_type_defs.h:133

References F77_cheevr(), F77_dsyevr(), F77_ssyevr(), F77_zheevr(), FLA_Check_error_level(), FLA_Hevdr_check(), FLA_Mach_params(), FLA_Obj_col_stride(), FLA_Obj_create(), FLA_Obj_datatype(), FLA_Obj_datatype_proj_to_real(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_is_complex(), FLA_Obj_width(), FLA_Param_map_flame_to_netlib_evd_type(), FLA_Param_map_flame_to_netlib_uplo(), and i.

Generated on Thu Sep 23 2021 17:46:17 for libflame by doxygen 1.12.0