libflame  revision_anchor
Functions
FLA_Bidiag_blk_external.c File Reference

(r)

Functions

FLA_Error FLA_Bidiag_blk_external (FLA_Obj A, FLA_Obj tu, FLA_Obj tv)
 
FLA_Error FLA_Bidiag_blk_ext (FLA_Obj A, FLA_Obj tu, FLA_Obj tv)
 

Function Documentation

◆ FLA_Bidiag_blk_ext()

FLA_Error FLA_Bidiag_blk_ext ( FLA_Obj  A,
FLA_Obj  tu,
FLA_Obj  tv 
)

References FLA_Bidiag_blk_external().

150 {
151  return FLA_Bidiag_blk_external( A, tu, tv );
152 }
FLA_Error FLA_Bidiag_blk_external(FLA_Obj A, FLA_Obj tu, FLA_Obj tv)
Definition: FLA_Bidiag_blk_external.c:13

◆ FLA_Bidiag_blk_external()

FLA_Error FLA_Bidiag_blk_external ( FLA_Obj  A,
FLA_Obj  tu,
FLA_Obj  tv 
)

References F77_cgebrd(), F77_dgebrd(), F77_sgebrd(), F77_zgebrd(), FLA_Bidiag_check(), 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_length(), FLA_Obj_max_dim(), FLA_Obj_min_dim(), FLA_Obj_width(), and FLA_Query_blocksize().

Referenced by FLA_Bidiag_blk_ext().

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