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 }
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)
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)
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)
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)
void FLA_Param_map_flame_to_netlib_evd_type(FLA_Evd_type evd_type, void *lapack_evd_type)
Definition: FLA_Param.c:151
dim_t FLA_Obj_width(FLA_Obj obj)
Definition: FLA_Query.c:123
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_Bool FLA_Obj_has_zero_dim(FLA_Obj A)
Definition: FLA_Query.c:400
FLA_Datatype FLA_Obj_datatype_proj_to_real(FLA_Obj A)
Definition: FLA_Query.c:23
dim_t FLA_Obj_col_stride(FLA_Obj obj)
Definition: FLA_Query.c:174
FLA_Error FLA_Obj_free(FLA_Obj *obj)
Definition: FLA_Obj.c:588
FLA_Datatype FLA_Obj_datatype(FLA_Obj obj)
Definition: FLA_Query.c:13
int FLA_Datatype
Definition: FLA_type_defs.h:49
int i
Definition: bl1_axmyv2.c:145
Definition: FLA_type_defs.h:159
Definition: blis_type_defs.h:138
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.