libflame  revision_anchor
Functions
FLA_Hevdd_external.c File Reference

(r)

Functions

FLA_Error FLA_Hevdd_external (FLA_Evd_type jobz, FLA_Uplo uplo, FLA_Obj A, FLA_Obj e)
 

Function Documentation

◆ FLA_Hevdd_external()

FLA_Error FLA_Hevdd_external ( FLA_Evd_type  jobz,
FLA_Uplo  uplo,
FLA_Obj  A,
FLA_Obj  e 
)

References F77_cheevd(), F77_dsyevd(), F77_ssyevd(), F77_zheevd(), FLA_Check_error_level(), FLA_Hevdd_check(), 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.

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