libflame revision_anchor
Functions
FLA_Tevdr_external.c File Reference

(r)

Functions

FLA_Error FLA_Tevdr_external (FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj l, FLA_Obj A)
 

Function Documentation

◆ FLA_Tevdr_external()

FLA_Error FLA_Tevdr_external ( FLA_Evd_type  jobz,
FLA_Obj  d,
FLA_Obj  e,
FLA_Obj  l,
FLA_Obj  A 
)
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 lisuppz, lwork, liwork;
21 FLA_Obj isuppz, work, iwork;
22 char blas_jobz;
23 char blas_range;
24 int i;
25 int vl, vu;
26 int il, iu;
27 int nzc;
28 int try_rac;
29 int n_eig_found;
30
31 //if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
32 // FLA_Tevdd_check( jobz, d, e, A );
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
42 FLA_Param_map_flame_to_netlib_evd_type( jobz, &blas_jobz );
43
44 // Hard-code some parameters.
45 blas_range = 'A';
46 nzc = n_A;
47 try_rac = TRUE;
48
49 // Allocate space for the isuppz array.
50 lisuppz = 2 * n_A;
51 FLA_Obj_create( FLA_INT, lisuppz, 1, 0, 0, &isuppz );
52
53 // Make a workspace query the first time through. This will provide us with
54 // and ideal workspace size.
55 lwork = -1;
56 liwork = -1;
57 FLA_Obj_create( dt_real, 1, 1, 0, 0, &work );
58 FLA_Obj_create( FLA_INT, 1, 1, 0, 0, &iwork );
59
60 for ( i = 0; i < 2; ++i )
61 {
62 if ( i == 1 )
63 {
64 // Grab the queried ideal workspace size from the work arrays, free the
65 // work object, and then re-allocate the workspace with the ideal size.
66 if ( datatype == FLA_FLOAT || datatype == FLA_COMPLEX )
67 {
68 lwork = ( int ) *FLA_FLOAT_PTR( work );
69 liwork = ( int ) *FLA_INT_PTR( iwork );
70 }
71 else if ( datatype == FLA_DOUBLE || datatype == FLA_DOUBLE_COMPLEX )
72 {
73 lwork = ( int ) *FLA_DOUBLE_PTR( work );
74 liwork = ( int ) *FLA_INT_PTR( iwork );
75 }
76//printf( "ideal workspace for n = %d\n", n_A );
77//printf( " lwork = %d\n", lwork );
78//printf( " liwork = %d\n", liwork );
79 FLA_Obj_free( &work );
80 FLA_Obj_free( &iwork );
81 FLA_Obj_create( dt_real, lwork, 1, 0, 0, &work );
82 FLA_Obj_create( FLA_INT, liwork, 1, 0, 0, &iwork );
83 }
84
85 switch( datatype ) {
86
87 case FLA_FLOAT:
88 {
89 float* buff_d = ( float* ) FLA_FLOAT_PTR( d );
90 float* buff_e = ( float* ) FLA_FLOAT_PTR( e );
91 float* buff_l = ( float* ) FLA_FLOAT_PTR( l );
92 float* buff_A = ( float* ) FLA_FLOAT_PTR( A );
93 int* buff_isuppz = ( int* ) FLA_INT_PTR( isuppz );
94 float* buff_work = ( float* ) FLA_FLOAT_PTR( work );
95 int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
96
97 F77_sstemr( &blas_jobz,
98 &blas_range,
99 &n_A,
100 buff_d,
101 buff_e,
102 &vl, &vu,
103 &il, &iu,
104 &n_eig_found,
105 buff_l,
106 buff_A, &cs_A,
107 &nzc,
108 buff_isuppz,
109 &try_rac,
110 buff_work, &lwork,
111 buff_iwork, &liwork,
112 &info );
113
114 break;
115 }
116
117 case FLA_DOUBLE:
118 {
119 double* buff_d = ( double* ) FLA_DOUBLE_PTR( d );
120 double* buff_e = ( double* ) FLA_DOUBLE_PTR( e );
121 double* buff_l = ( double* ) FLA_DOUBLE_PTR( l );
122 double* buff_A = ( double* ) FLA_DOUBLE_PTR( A );
123 int* buff_isuppz = ( int* ) FLA_INT_PTR( isuppz );
124 double* buff_work = ( double* ) FLA_DOUBLE_PTR( work );
125 int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
126
127 F77_dstemr( &blas_jobz,
128 &blas_range,
129 &n_A,
130 buff_d,
131 buff_e,
132 &vl, &vu,
133 &il, &iu,
134 &n_eig_found,
135 buff_l,
136 buff_A, &cs_A,
137 &nzc,
138 buff_isuppz,
139 &try_rac,
140 buff_work, &lwork,
141 buff_iwork, &liwork,
142 &info );
143
144 break;
145 }
146
147 case FLA_COMPLEX:
148 {
149 float* buff_d = ( float* ) FLA_FLOAT_PTR( d );
150 float* buff_e = ( float* ) FLA_FLOAT_PTR( e );
151 float* buff_l = ( float* ) FLA_FLOAT_PTR( l );
152 scomplex* buff_A = ( scomplex* ) FLA_COMPLEX_PTR( A );
153 int* buff_isuppz = ( int* ) FLA_INT_PTR( isuppz );
154 float* buff_work = ( float* ) FLA_FLOAT_PTR( work );
155 int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
156
157 F77_cstemr( &blas_jobz,
158 &blas_range,
159 &n_A,
160 buff_d,
161 buff_e,
162 &vl, &vu,
163 &il, &iu,
164 &n_eig_found,
165 buff_l,
166 buff_A, &cs_A,
167 &nzc,
168 buff_isuppz,
169 &try_rac,
170 buff_work, &lwork,
171 buff_iwork, &liwork,
172 &info );
173
174 break;
175 }
176
177 case FLA_DOUBLE_COMPLEX:
178 {
179 double* buff_d = ( double* ) FLA_DOUBLE_PTR( d );
180 double* buff_e = ( double* ) FLA_DOUBLE_PTR( e );
181 double* buff_l = ( double* ) FLA_DOUBLE_PTR( l );
182 dcomplex* buff_A = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( A );
183 int* buff_isuppz = ( int* ) FLA_INT_PTR( isuppz );
184 double* buff_work = ( double* ) FLA_DOUBLE_PTR( work );
185 int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
186
187 F77_zstemr( &blas_jobz,
188 &blas_range,
189 &n_A,
190 buff_d,
191 buff_e,
192 &vl, &vu,
193 &il, &iu,
194 &n_eig_found,
195 buff_l,
196 buff_A, &cs_A,
197 &nzc,
198 buff_isuppz,
199 &try_rac,
200 buff_work, &lwork,
201 buff_iwork, &liwork,
202 &info );
203
204 break;
205 }
206
207 }
208 }
209
210 FLA_Obj_free( &isuppz );
211 FLA_Obj_free( &work );
212 FLA_Obj_free( &iwork );
213#else
214 FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
215#endif
216
217 return info;
218}
F77_sstemr
int F77_sstemr(char *jobz, char *range, int *n, float *d, float *e, int *vl, int *vu, int *il, int *iu, int *m, float *w, float *z, int *ldz, int *nzc, int *isuppz, int *tryrac, float *work, int *lwork, int *iwork, int *liwork, int *info)
F77_zstemr
int F77_zstemr(char *jobz, char *range, int *n, double *d, double *e, int *vl, int *vu, int *il, int *iu, int *m, double *w, dcomplex *z, int *ldz, int *nzc, int *isuppz, int *tryrac, double *work, int *lwork, int *iwork, int *liwork, int *info)
F77_dstemr
int F77_dstemr(char *jobz, char *range, int *n, double *d, double *e, int *vl, int *vu, int *il, int *iu, int *m, double *w, double *z, int *ldz, int *nzc, int *isuppz, int *tryrac, double *work, int *lwork, int *iwork, int *liwork, int *info)
F77_cstemr
int F77_cstemr(char *jobz, char *range, int *n, float *d, float *e, int *vl, int *vu, int *il, int *iu, int *m, float *w, scomplex *z, int *ldz, int *nzc, int *isuppz, int *tryrac, float *work, int *lwork, 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_col_stride
dim_t FLA_Obj_col_stride(FLA_Obj obj)
Definition FLA_Query.c:174
FLA_Obj_free
FLA_Error FLA_Obj_free(FLA_Obj *obj)
Definition FLA_Obj.c:588
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
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_cstemr(), F77_dstemr(), F77_sstemr(), F77_zstemr(), 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_width(), FLA_Param_map_flame_to_netlib_evd_type(), and i.

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