libflame  revision_anchor
Functions
FLA_Bidiag_form_U_external.c File Reference

(r)

Functions

FLA_Error FLA_Bidiag_form_U_external (FLA_Obj A, FLA_Obj t)
 

Function Documentation

◆ FLA_Bidiag_form_U_external()

FLA_Error FLA_Bidiag_form_U_external ( FLA_Obj  A,
FLA_Obj  t 
)
14 {
15  int info = 0;
16 #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES
17  FLA_Datatype datatype;
18  int m_A, n_A, k_A;
19  int cs_A;
20  int min_m_n;
21  int lwork;
22  FLA_Obj work;
23  char blas_vect = 'Q';
24  int i;
25 
26  if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
28 
29  if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
30 
31  datatype = FLA_Obj_datatype( A );
32 
33  m_A = FLA_Obj_length( A );
34  n_A = FLA_Obj_width( A );
35  cs_A = FLA_Obj_col_stride( A );
36 
37  min_m_n = FLA_Obj_min_dim( A );
38 
39  if ( blas_vect == 'Q' ) k_A = FLA_Obj_vector_dim( t );
40  else k_A = FLA_Obj_vector_dim( t ) + 1;
41 
42  // Make a workspace query the first time through. This will provide us with
43  // and ideal workspace size based on an internal block size.
44  lwork = -1;
45  FLA_Obj_create( datatype, 1, 1, 0, 0, &work );
46 
47  for ( i = 0; i < 2; ++i )
48  {
49  if ( i == 1 )
50  {
51  // Grab the queried ideal workspace size from the work array, free the
52  // work object, and then re-allocate the workspace with the ideal size.
53  if ( datatype == FLA_FLOAT || datatype == FLA_COMPLEX )
54  lwork = ( int ) *FLA_FLOAT_PTR( work );
55  else if ( datatype == FLA_DOUBLE || datatype == FLA_DOUBLE_COMPLEX )
56  lwork = ( int ) *FLA_DOUBLE_PTR( work );
57 
58  FLA_Obj_free( &work );
59  FLA_Obj_create( datatype, lwork, 1, 0, 0, &work );
60  }
61 
62  switch( datatype ){
63 
64  case FLA_FLOAT:
65  {
66  float* buff_A = ( float * ) FLA_FLOAT_PTR( A );
67  float* buff_t = ( float * ) FLA_FLOAT_PTR( t );
68  float* buff_work = ( float * ) FLA_FLOAT_PTR( work );
69 
70  F77_sorgbr( &blas_vect,
71  &m_A,
72  &n_A,
73  &k_A,
74  buff_A, &cs_A,
75  buff_t,
76  buff_work, &lwork,
77  &info );
78 
79  break;
80  }
81 
82  case FLA_DOUBLE:
83  {
84  double* buff_A = ( double * ) FLA_DOUBLE_PTR( A );
85  double* buff_t = ( double * ) FLA_DOUBLE_PTR( t );
86  double* buff_work = ( double * ) FLA_DOUBLE_PTR( work );
87 
88  F77_dorgbr( &blas_vect,
89  &m_A,
90  &n_A,
91  &k_A,
92  buff_A, &cs_A,
93  buff_t,
94  buff_work, &lwork,
95  &info );
96 
97  break;
98  }
99 
100  case FLA_COMPLEX:
101  {
102  scomplex* buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
103  scomplex* buff_t = ( scomplex * ) FLA_COMPLEX_PTR( t );
104  scomplex* buff_work = ( scomplex * ) FLA_COMPLEX_PTR( work );
105 
106  F77_cungbr( &blas_vect,
107  &m_A,
108  &n_A,
109  &k_A,
110  buff_A, &cs_A,
111  buff_t,
112  buff_work, &lwork,
113  &info );
114 
115  break;
116  }
117 
118  case FLA_DOUBLE_COMPLEX:
119  {
120  dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
121  dcomplex *buff_t = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( t );
122  dcomplex *buff_work = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( work );
123 
124  F77_zungbr( &blas_vect,
125  &m_A,
126  &n_A,
127  &k_A,
128  buff_A, &cs_A,
129  buff_t,
130  buff_work, &lwork,
131  &info );
132 
133  break;
134  }
135 
136  }
137 
138  }
139 
140  FLA_Obj_free( &work );
141 #else
142  FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
143 #endif
144 
145  return info;
146 }
FLA_Error FLA_Bidiag_form_U_check(FLA_Obj A, FLA_Obj t)
Definition: FLA_Bidiag_form_U_check.c:13
int F77_cungbr(char *vect, int *m, int *n, int *k, scomplex *a, int *lda, scomplex *tau, scomplex *work, int *lwork, int *info)
int F77_dorgbr(char *vect, int *m, int *n, int *k, double *a, int *lda, double *tau, double *work, int *lwork, int *info)
int F77_zungbr(char *vect, int *m, int *n, int *k, dcomplex *a, int *lda, dcomplex *tau, dcomplex *work, int *lwork, int *info)
int F77_sorgbr(char *vect, int *m, int *n, int *k, float *a, int *lda, float *tau, float *work, int *lwork, int *info)
dim_t FLA_Obj_width(FLA_Obj obj)
Definition: FLA_Query.c:123
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
dim_t FLA_Obj_length(FLA_Obj obj)
Definition: FLA_Query.c:116
dim_t FLA_Obj_col_stride(FLA_Obj obj)
Definition: FLA_Query.c:174
unsigned int FLA_Check_error_level(void)
Definition: FLA_Check.c:18
dim_t FLA_Obj_min_dim(FLA_Obj obj)
Definition: FLA_Query.c:153
FLA_Error FLA_Obj_free(FLA_Obj *obj)
Definition: FLA_Obj.c:588
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
int i
Definition: bl1_axmyv2.c:145
Definition: FLA_type_defs.h:159
Definition: blis_type_defs.h:138
Definition: blis_type_defs.h:133

References F77_cungbr(), F77_dorgbr(), F77_sorgbr(), F77_zungbr(), FLA_Bidiag_form_U_check(), FLA_Check_error_level(), FLA_Obj_col_stride(), FLA_Obj_create(), FLA_Obj_datatype(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_length(), FLA_Obj_min_dim(), FLA_Obj_vector_dim(), FLA_Obj_width(), and i.