libflame  revision_anchor
Functions
FLA_Tevdd_external.c File Reference

(r)

Functions

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

Function Documentation

◆ FLA_Tevdd_external()

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

References F77_cstedc(), F77_dstedc(), F77_sstedc(), F77_zstedc(), 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(), and i.

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 lwork, lrwork, liwork;
21  FLA_Obj work, rwork, iwork;
22  char blas_jobz;
23  int i;
24 
25  //if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
26  // FLA_Tevdd_check( jobz, d, e, A );
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_width( A );
34  cs_A = FLA_Obj_col_stride( A );
35 
36  FLA_Param_map_flame_to_netlib_evd_type( jobz, &blas_jobz );
37 
38  // Make a workspace query the first time through. This will provide us with
39  // and ideal workspace size.
40  lwork = -1;
41  lrwork = -1;
42  liwork = -1;
43  FLA_Obj_create( datatype, 1, 1, 0, 0, &work );
44  FLA_Obj_create( datatype, 1, 1, 0, 0, &rwork );
45  FLA_Obj_create( FLA_INT, 1, 1, 0, 0, &iwork );
46 
47  for ( i = 0; i < 2; ++i )
48  {
49  if ( i == 1 )
50  {
51  // Grab the queried ideal workspace size from the work arrays, free the
52  // work object, and then re-allocate the workspace with the ideal size.
53  if ( datatype == FLA_FLOAT || datatype == FLA_COMPLEX )
54  {
55  lwork = ( int ) *FLA_FLOAT_PTR( work );
56  lrwork = ( int ) *FLA_FLOAT_PTR( rwork );
57  liwork = ( int ) *FLA_INT_PTR( iwork );
58  }
59  else if ( datatype == FLA_DOUBLE || datatype == FLA_DOUBLE_COMPLEX )
60  {
61  lwork = ( int ) *FLA_DOUBLE_PTR( work );
62  lrwork = ( int ) *FLA_DOUBLE_PTR( rwork );
63  liwork = ( int ) *FLA_INT_PTR( iwork );
64  }
65 
66 //printf( "ideal workspace for n = %d\n", n_A );
67 //printf( " lwork = %d\n", lwork );
68 //printf( " lrwork = %d\n", lrwork );
69 //printf( " liwork = %d\n", liwork );
70 
71  FLA_Obj_free( &work );
72  FLA_Obj_free( &iwork );
73  FLA_Obj_free( &rwork );
74  FLA_Obj_create( datatype, lwork, 1, 0, 0, &work );
75  FLA_Obj_create( datatype, liwork, 1, 0, 0, &iwork );
76  if ( FLA_Obj_is_complex( A ) )
77  FLA_Obj_create( datatype, lrwork, 1, 0, 0, &rwork );
78  }
79 
80  switch( datatype ) {
81 
82  case FLA_FLOAT:
83  {
84  float* buff_d = ( float* ) FLA_FLOAT_PTR( d );
85  float* buff_e = ( float* ) FLA_FLOAT_PTR( e );
86  float* buff_A = ( float* ) FLA_FLOAT_PTR( A );
87  float* buff_work = ( float* ) FLA_FLOAT_PTR( work );
88  int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
89 
90  F77_sstedc( &blas_jobz,
91  &n_A,
92  buff_d,
93  buff_e,
94  buff_A, &cs_A,
95  buff_work, &lwork,
96  buff_iwork, &liwork,
97  &info );
98 
99  break;
100  }
101 
102  case FLA_DOUBLE:
103  {
104  double* buff_d = ( double* ) FLA_DOUBLE_PTR( d );
105  double* buff_e = ( double* ) FLA_DOUBLE_PTR( e );
106  double* buff_A = ( double* ) FLA_DOUBLE_PTR( A );
107  double* buff_work = ( double* ) FLA_DOUBLE_PTR( work );
108  int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
109 
110  F77_dstedc( &blas_jobz,
111  &n_A,
112  buff_d,
113  buff_e,
114  buff_A, &cs_A,
115  buff_work, &lwork,
116  buff_iwork, &liwork,
117  &info );
118 
119  break;
120  }
121 
122  case FLA_COMPLEX:
123  {
124  float* buff_d = ( float* ) FLA_FLOAT_PTR( d );
125  float* buff_e = ( float* ) FLA_FLOAT_PTR( e );
126  scomplex* buff_A = ( scomplex* ) FLA_COMPLEX_PTR( A );
127  scomplex* buff_work = ( scomplex* ) FLA_COMPLEX_PTR( work );
128  float* buff_rwork = ( float* ) FLA_FLOAT_PTR( rwork );
129  int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
130 
131  F77_cstedc( &blas_jobz,
132  &n_A,
133  buff_d,
134  buff_e,
135  buff_A, &cs_A,
136  buff_work, &lwork,
137  buff_rwork, &lrwork,
138  buff_iwork, &liwork,
139  &info );
140 
141  break;
142  }
143 
144  case FLA_DOUBLE_COMPLEX:
145  {
146  double* buff_d = ( double* ) FLA_DOUBLE_PTR( d );
147  double* buff_e = ( double* ) FLA_DOUBLE_PTR( e );
148  dcomplex* buff_A = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( A );
149  dcomplex* buff_work = ( dcomplex* ) FLA_DOUBLE_COMPLEX_PTR( work );
150  double* buff_rwork = ( double* ) FLA_DOUBLE_PTR( rwork );
151  int* buff_iwork = ( int* ) FLA_INT_PTR( iwork );
152 
153  F77_zstedc( &blas_jobz,
154  &n_A,
155  buff_d,
156  buff_e,
157  buff_A, &cs_A,
158  buff_work, &lwork,
159  buff_rwork, &lrwork,
160  buff_iwork, &liwork,
161  &info );
162 
163  break;
164  }
165 
166  }
167  }
168 
169  FLA_Obj_free( &work );
170  FLA_Obj_free( &iwork );
171  if ( FLA_Obj_is_complex( A ) )
172  FLA_Obj_free( &rwork );
173 #else
174  FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
175 #endif
176 
177  return info;
178 }
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
int F77_sstedc(char *compz, int *n, float *d, float *e, float *z, int *ldz, float *work, int *lwork, int *iwork, int *liwork, int *info)
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
Definition: FLA_type_defs.h:158
FLA_Bool FLA_Obj_has_zero_dim(FLA_Obj A)
Definition: FLA_Query.c:400
dim_t FLA_Obj_width(FLA_Obj obj)
Definition: FLA_Query.c:123
FLA_Datatype FLA_Obj_datatype_proj_to_real(FLA_Obj A)
Definition: FLA_Query.c:23
Definition: blis_type_defs.h:132
int F77_cstedc(char *compz, int *n, float *d, float *e, scomplex *z, int *ldz, scomplex *work, int *lwork, float *rwork, int *lrwork, 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
int F77_zstedc(char *compz, int *n, double *d, double *e, dcomplex *z, int *ldz, dcomplex *work, int *lwork, double *rwork, int *lrwork, int *iwork, int *liwork, int *info)
int FLA_Datatype
Definition: FLA_type_defs.h:49
dim_t FLA_Obj_col_stride(FLA_Obj obj)
Definition: FLA_Query.c:174
int i
Definition: bl1_axmyv2.c:145
int F77_dstedc(char *compz, int *n, double *d, double *e, double *z, int *ldz, double *work, int *lwork, int *iwork, int *liwork, int *info)
FLA_Bool FLA_Obj_is_complex(FLA_Obj A)
Definition: FLA_Query.c:324
Definition: blis_type_defs.h:137