libflame  revision_anchor
Functions
FLA_Tevd_external.c File Reference

(r)

Functions

FLA_Error FLA_Tevd_external (FLA_Evd_type jobz, FLA_Obj d, FLA_Obj e, FLA_Obj A)
 

Function Documentation

◆ FLA_Tevd_external()

FLA_Error FLA_Tevd_external ( FLA_Evd_type  jobz,
FLA_Obj  d,
FLA_Obj  e,
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 inc_d, inc_e;
21  int lwork;
22  FLA_Obj work, d_use, e_use;
23  char blas_jobz;
24 
25  //if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
26  // FLA_Hevd_check( jobz, uplo, A, e );
27 
28  if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
29 
30  datatype = FLA_Obj_datatype( A );
31  dt_real = FLA_Obj_datatype_proj_to_real( A );
32 
33  n_A = FLA_Obj_vector_dim( d );
34  cs_A = FLA_Obj_col_stride( A );
35 
36  if ( FLA_Obj_vector_inc( d ) != 1 )
37  {
38  FLA_Obj_create( dt_real, n_A, 1, 0, 0, &d_use );
39  FLA_Copy( d, d_use );
40  }
41  else { d_use = d; }
42 
43  if ( FLA_Obj_vector_inc( e ) != 1 )
44  {
45  FLA_Obj_create( dt_real, n_A-1, 1, 0, 0, &e_use );
46  FLA_Copy( e, e_use );
47  }
48  else { e_use = e; }
49 
50  inc_d = FLA_Obj_vector_inc( d_use );
51  inc_e = FLA_Obj_vector_inc( e_use );
52 
53  // Allocate thw work array up front.
54  lwork = max( 1.0, 2.0 * n_A - 2 );
55  FLA_Obj_create( dt_real, lwork, 1, 0, 0, &work );
56 
57  FLA_Param_map_flame_to_netlib_evd_type( jobz, &blas_jobz );
58 
59  switch( datatype ) {
60 
61  case FLA_FLOAT:
62  {
63  float* buff_A = ( float * ) FLA_FLOAT_PTR( A );
64  float* buff_d = ( float * ) FLA_FLOAT_PTR( d_use );
65  float* buff_e = ( float * ) FLA_FLOAT_PTR( e_use );
66  float* buff_work = ( float * ) FLA_FLOAT_PTR( work );
67 
68  F77_ssteqr( &blas_jobz,
69  &n_A,
70  buff_d,
71  buff_e,
72  buff_A, &cs_A,
73  buff_work,
74  &info );
75 
76  break;
77  }
78 
79  case FLA_DOUBLE:
80  {
81  double* buff_A = ( double * ) FLA_DOUBLE_PTR( A );
82  double* buff_d = ( double * ) FLA_DOUBLE_PTR( d_use );
83  double* buff_e = ( double * ) FLA_DOUBLE_PTR( e_use );
84  double* buff_work = ( double * ) FLA_DOUBLE_PTR( work );
85 
86  F77_dsteqr( &blas_jobz,
87  &n_A,
88  buff_d,
89  buff_e,
90  buff_A, &cs_A,
91  buff_work,
92  &info );
93 
94  break;
95  }
96 
97  case FLA_COMPLEX:
98  {
99  scomplex* buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
100  float* buff_d = ( float * ) FLA_FLOAT_PTR( d_use );
101  float* buff_e = ( float * ) FLA_FLOAT_PTR( e_use );
102  float* buff_work = ( float * ) FLA_FLOAT_PTR( work );
103 
104  F77_csteqr( &blas_jobz,
105  &n_A,
106  buff_d,
107  buff_e,
108  buff_A, &cs_A,
109  buff_work,
110  &info );
111 
112  break;
113  }
114 
115  case FLA_DOUBLE_COMPLEX:
116  {
117  dcomplex* buff_A = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( A );
118  double* buff_d = ( double* ) FLA_DOUBLE_PTR( d_use );
119  double* buff_e = ( double* ) FLA_DOUBLE_PTR( e_use );
120  double* buff_work = ( double* ) FLA_DOUBLE_PTR( work );
121 
122  F77_zsteqr( &blas_jobz,
123  &n_A,
124  buff_d,
125  buff_e,
126  buff_A, &cs_A,
127  buff_work,
128  &info );
129 
130  break;
131  }
132 
133  }
134 
135  if ( FLA_Obj_vector_inc( d ) != 1 )
136  {
137  FLA_Copy( d_use, d );
138  FLA_Obj_free( &d_use );
139  }
140  if ( FLA_Obj_vector_inc( e ) != 1 )
141  {
142  FLA_Copy( e_use, e );
143  FLA_Obj_free( &e_use );
144  }
145 
146  FLA_Obj_free( &work );
147 
148 #else
149  FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
150 #endif
151 
152  return info;
153 }
FLA_Error FLA_Copy(FLA_Obj A, FLA_Obj B)
Definition: FLA_Copy.c:15
int F77_ssteqr(char *jobz, int *n, float *d, float *e, float *z, int *ldz, float *work, int *info)
int F77_csteqr(char *jobz, int *n, float *d, float *e, scomplex *z, int *ldz, float *work, int *info)
int F77_dsteqr(char *jobz, int *n, double *d, double *e, double *z, int *ldz, double *work, int *info)
int F77_zsteqr(char *jobz, int *n, double *d, double *e, dcomplex *z, int *ldz, double *work, 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
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
dim_t FLA_Obj_vector_inc(FLA_Obj obj)
Definition: FLA_Query.c:145
dim_t FLA_Obj_vector_dim(FLA_Obj obj)
Definition: FLA_Query.c:137
FLA_Datatype FLA_Obj_datatype(FLA_Obj obj)
Definition: FLA_Query.c:13
int FLA_Datatype
Definition: FLA_type_defs.h:49
Definition: FLA_type_defs.h:159
Definition: blis_type_defs.h:138
Definition: blis_type_defs.h:133

References F77_csteqr(), F77_dsteqr(), F77_ssteqr(), F77_zsteqr(), FLA_Copy(), 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_vector_dim(), FLA_Obj_vector_inc(), and FLA_Param_map_flame_to_netlib_evd_type().