libflame  revision_anchor
Functions
FLA_Tridiag_blk_external.c File Reference

(r)

Functions

FLA_Error FLA_Tridiag_blk_external (FLA_Uplo uplo, FLA_Obj A, FLA_Obj t)
 
FLA_Error FLA_Tridiag_blk_ext (FLA_Uplo uplo, FLA_Obj A, FLA_Obj t)
 

Function Documentation

◆ FLA_Tridiag_blk_ext()

FLA_Error FLA_Tridiag_blk_ext ( FLA_Uplo  uplo,
FLA_Obj  A,
FLA_Obj  t 
)

References FLA_Tridiag_blk_external().

141 {
142  return FLA_Tridiag_blk_external( uplo, A, t );
143 }
FLA_Error FLA_Tridiag_blk_external(FLA_Uplo uplo, FLA_Obj A, FLA_Obj t)
Definition: FLA_Tridiag_blk_external.c:13

◆ FLA_Tridiag_blk_external()

FLA_Error FLA_Tridiag_blk_external ( FLA_Uplo  uplo,
FLA_Obj  A,
FLA_Obj  t 
)

References F77_chetrd(), F77_dsytrd(), F77_ssytrd(), F77_zhetrd(), FLA_Check_error_level(), 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_uplo(), FLA_Query_blocksize(), and FLA_Tridiag_check().

Referenced by FLA_Tridiag_blk_ext().

14 {
15  int info = 0;
16 #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES
17  FLA_Datatype datatype;
18  int n_A, cs_A;
19  int lwork;
20  FLA_Obj d, e, work_obj;
21  char blas_uplo;
22 
23  if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
24  FLA_Tridiag_check( uplo, A, t );
25 
26  if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
27 
28  datatype = FLA_Obj_datatype( A );
29 
30  n_A = FLA_Obj_width( A );
31  cs_A = FLA_Obj_col_stride( A );
32 
33  FLA_Obj_create( FLA_Obj_datatype_proj_to_real( A ), n_A, 1, 0, 0, &d );
34  FLA_Obj_create( FLA_Obj_datatype_proj_to_real( A ), n_A - 1, 1, 0, 0, &e );
35 
36  lwork = n_A * FLA_Query_blocksize( datatype, FLA_DIMENSION_MIN );
37  FLA_Obj_create( datatype, lwork, 1, 0, 0, &work_obj );
38 
39  FLA_Param_map_flame_to_netlib_uplo( uplo, &blas_uplo );
40 
41 
42  switch( datatype ){
43 
44  case FLA_FLOAT:
45  {
46  float* buff_A = ( float * ) FLA_FLOAT_PTR( A );
47  float* buff_d = ( float * ) FLA_FLOAT_PTR( d );
48  float* buff_e = ( float * ) FLA_FLOAT_PTR( e );
49  float* buff_t = ( float * ) FLA_FLOAT_PTR( t );
50  float* buff_work = ( float * ) FLA_FLOAT_PTR( work_obj );
51 
52  F77_ssytrd( &blas_uplo,
53  &n_A,
54  buff_A, &cs_A,
55  buff_d,
56  buff_e,
57  buff_t,
58  buff_work,
59  &lwork,
60  &info );
61 
62  break;
63  }
64 
65  case FLA_DOUBLE:
66  {
67  double* buff_A = ( double * ) FLA_DOUBLE_PTR( A );
68  double* buff_d = ( double * ) FLA_DOUBLE_PTR( d );
69  double* buff_e = ( double * ) FLA_DOUBLE_PTR( e );
70  double* buff_t = ( double * ) FLA_DOUBLE_PTR( t );
71  double* buff_work = ( double * ) FLA_DOUBLE_PTR( work_obj );
72 
73  F77_dsytrd( &blas_uplo,
74  &n_A,
75  buff_A, &cs_A,
76  buff_d,
77  buff_e,
78  buff_t,
79  buff_work,
80  &lwork,
81  &info );
82 
83  break;
84  }
85 
86  case FLA_COMPLEX:
87  {
88  scomplex* buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
89  float* buff_d = ( float * ) FLA_FLOAT_PTR( d );
90  float* buff_e = ( float * ) FLA_FLOAT_PTR( e );
91  scomplex* buff_t = ( scomplex * ) FLA_COMPLEX_PTR( t );
92  scomplex* buff_work = ( scomplex * ) FLA_COMPLEX_PTR( work_obj );
93 
94  F77_chetrd( &blas_uplo,
95  &n_A,
96  buff_A, &cs_A,
97  buff_d,
98  buff_e,
99  buff_t,
100  buff_work,
101  &lwork,
102  &info );
103 
104  break;
105  }
106 
107  case FLA_DOUBLE_COMPLEX:
108  {
109  dcomplex* buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
110  double* buff_d = ( double * ) FLA_DOUBLE_PTR( d );
111  double* buff_e = ( double * ) FLA_DOUBLE_PTR( e );
112  dcomplex* buff_t = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( t );
113  dcomplex* buff_work = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( work_obj );
114 
115  F77_zhetrd( &blas_uplo,
116  &n_A,
117  buff_A, &cs_A,
118  buff_d,
119  buff_e,
120  buff_t,
121  buff_work,
122  &lwork,
123  &info );
124 
125  break;
126  }
127 
128  }
129 
130  FLA_Obj_free( &d );
131  FLA_Obj_free( &e );
132  FLA_Obj_free( &work_obj );
133 #else
134  FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
135 #endif
136 
137  return info;
138 }
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_Error FLA_Obj_free(FLA_Obj *obj)
Definition: FLA_Obj.c:588
void FLA_Param_map_flame_to_netlib_uplo(FLA_Uplo uplo, void *blas_uplo)
Definition: FLA_Param.c:47
int F77_chetrd(char *uplo, int *n, scomplex *a, int *lda, float *d, float *e, scomplex *tau, scomplex *work, int *lwork, int *info)
int F77_dsytrd(char *uplo, int *n, double *a, int *lda, double *d, double *e, double *tau, double *work, int *lwork, int *info)
dim_t FLA_Query_blocksize(FLA_Datatype dt, FLA_Dimension dim)
Definition: FLA_Blocksize.c:161
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_Error FLA_Tridiag_check(FLA_Uplo uplo, FLA_Obj A, FLA_Obj t)
Definition: FLA_Tridiag_check.c:13
FLA_Datatype FLA_Obj_datatype_proj_to_real(FLA_Obj A)
Definition: FLA_Query.c:23
Definition: blis_type_defs.h:132
int F77_ssytrd(char *uplo, int *n, float *a, int *lda, float *d, float *e, float *tau, float *work, int *lwork, int *info)
unsigned int FLA_Check_error_level(void)
Definition: FLA_Check.c:18
int FLA_Datatype
Definition: FLA_type_defs.h:49
dim_t FLA_Obj_col_stride(FLA_Obj obj)
Definition: FLA_Query.c:174
int F77_zhetrd(char *uplo, int *n, dcomplex *a, int *lda, double *d, double *e, dcomplex *tau, dcomplex *work, int *lwork, int *info)
Definition: blis_type_defs.h:137