libflame  revision_anchor
Functions
FLA_Apply_Q_blk_external.c File Reference

(r)

Functions

FLA_Error FLA_Apply_Q_blk_external (FLA_Side side, FLA_Trans trans, FLA_Store storev, FLA_Obj A, FLA_Obj t, FLA_Obj B)
 

Function Documentation

◆ FLA_Apply_Q_blk_external()

FLA_Error FLA_Apply_Q_blk_external ( FLA_Side  side,
FLA_Trans  trans,
FLA_Store  storev,
FLA_Obj  A,
FLA_Obj  t,
FLA_Obj  B 
)

References F77_cunmlq(), F77_cunmqr(), F77_dormlq(), F77_dormqr(), F77_sormlq(), F77_sormqr(), F77_zunmlq(), F77_zunmqr(), FLA_Apply_Q_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_vector_dim(), FLA_Obj_width(), FLA_Param_map_flame_to_netlib_side(), FLA_Param_map_flame_to_netlib_trans(), and FLA_Query_blocksize().

14 {
15  int info = 0;
16 #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES
17  FLA_Datatype datatype;
18  // int m_A, n_A;
19  int m_B, n_B;
20  int cs_A;
21  int cs_B;
22  int k_t;
23  int lwork;
24  char blas_side;
25  char blas_trans;
26  FLA_Obj work_obj;
27 
28  if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
29  FLA_Apply_Q_check( side, trans, storev, A, t, B );
30 
31  if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
32 
33  datatype = FLA_Obj_datatype( A );
34 
35  // m_A = FLA_Obj_length( A );
36  // n_A = FLA_Obj_width( A );
37  cs_A = FLA_Obj_col_stride( A );
38 
39  m_B = FLA_Obj_length( B );
40  n_B = FLA_Obj_width( B );
41  cs_B = FLA_Obj_col_stride( B );
42 
43  k_t = FLA_Obj_vector_dim( t );
44 
45  FLA_Param_map_flame_to_netlib_side( side, &blas_side );
46  FLA_Param_map_flame_to_netlib_trans( trans, &blas_trans );
47 
48  if ( side == FLA_LEFT )
49  lwork = n_B * FLA_Query_blocksize( datatype, FLA_DIMENSION_MIN );
50  else
51  lwork = m_B * FLA_Query_blocksize( datatype, FLA_DIMENSION_MIN );
52 
53  FLA_Obj_create( datatype, lwork, 1, 0, 0, &work_obj );
54 
55 
56  switch( datatype ){
57 
58  case FLA_FLOAT:
59  {
60  float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
61  float *buff_t = ( float * ) FLA_FLOAT_PTR( t );
62  float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
63  float *buff_work = ( float * ) FLA_FLOAT_PTR( work_obj );
64 
65  if ( storev == FLA_COLUMNWISE )
66  F77_sormqr( &blas_side,
67  &blas_trans,
68  &m_B,
69  &n_B,
70  &k_t,
71  buff_A, &cs_A,
72  buff_t,
73  buff_B, &cs_B,
74  buff_work, &lwork,
75  &info );
76  else // storev == FLA_ROWWISE
77  F77_sormlq( &blas_side,
78  &blas_trans,
79  &m_B,
80  &n_B,
81  &k_t,
82  buff_A, &cs_A,
83  buff_t,
84  buff_B, &cs_B,
85  buff_work, &lwork,
86  &info );
87 
88  break;
89  }
90 
91  case FLA_DOUBLE:
92  {
93  double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
94  double *buff_t = ( double * ) FLA_DOUBLE_PTR( t );
95  double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
96  double *buff_work = ( double * ) FLA_DOUBLE_PTR( work_obj );
97 
98  if ( storev == FLA_COLUMNWISE )
99  F77_dormqr( &blas_side,
100  &blas_trans,
101  &m_B,
102  &n_B,
103  &k_t,
104  buff_A, &cs_A,
105  buff_t,
106  buff_B, &cs_B,
107  buff_work, &lwork,
108  &info );
109  else // storev == FLA_ROWWISE
110  F77_dormlq( &blas_side,
111  &blas_trans,
112  &m_B,
113  &n_B,
114  &k_t,
115  buff_A, &cs_A,
116  buff_t,
117  buff_B, &cs_B,
118  buff_work, &lwork,
119  &info );
120 
121  break;
122  }
123 
124  case FLA_COMPLEX:
125  {
126  scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
127  scomplex *buff_t = ( scomplex * ) FLA_COMPLEX_PTR( t );
128  scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
129  scomplex *buff_work = ( scomplex * ) FLA_COMPLEX_PTR( work_obj );
130 
131  if ( storev == FLA_COLUMNWISE )
132  F77_cunmqr( &blas_side,
133  &blas_trans,
134  &m_B,
135  &n_B,
136  &k_t,
137  buff_A, &cs_A,
138  buff_t,
139  buff_B, &cs_B,
140  buff_work, &lwork,
141  &info );
142  else // storev == FLA_ROWWISE
143  F77_cunmlq( &blas_side,
144  &blas_trans,
145  &m_B,
146  &n_B,
147  &k_t,
148  buff_A, &cs_A,
149  buff_t,
150  buff_B, &cs_B,
151  buff_work, &lwork,
152  &info );
153 
154  break;
155  }
156 
157  case FLA_DOUBLE_COMPLEX:
158  {
159  dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
160  dcomplex *buff_t = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( t );
161  dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
162  dcomplex *buff_work = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( work_obj );
163 
164  if ( storev == FLA_COLUMNWISE )
165  F77_zunmqr( &blas_side,
166  &blas_trans,
167  &m_B,
168  &n_B,
169  &k_t,
170  buff_A, &cs_A,
171  buff_t,
172  buff_B, &cs_B,
173  buff_work, &lwork,
174  &info );
175  else // storev == FLA_ROWWISE
176  F77_zunmlq( &blas_side,
177  &blas_trans,
178  &m_B,
179  &n_B,
180  &k_t,
181  buff_A, &cs_A,
182  buff_t,
183  buff_B, &cs_B,
184  buff_work, &lwork,
185  &info );
186 
187  break;
188  }
189 
190  }
191 
192  FLA_Obj_free( &work_obj );
193 #else
194  FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
195 #endif
196 
197  return info;
198 }
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_zunmqr(char *side, char *trans, int *m, int *n, int *k, dcomplex *a, int *lda, dcomplex *tau, dcomplex *c, int *ldc, dcomplex *work, int *lwork, int *info)
int F77_cunmqr(char *side, char *trans, int *m, int *n, int *k, scomplex *a, int *lda, scomplex *tau, scomplex *c, int *ldc, scomplex *work, int *lwork, int *info)
FLA_Error FLA_Obj_free(FLA_Obj *obj)
Definition: FLA_Obj.c:588
void FLA_Param_map_flame_to_netlib_side(FLA_Uplo side, void *blas_side)
Definition: FLA_Param.c:71
void FLA_Param_map_flame_to_netlib_trans(FLA_Trans trans, void *blas_trans)
Definition: FLA_Param.c:15
dim_t FLA_Query_blocksize(FLA_Datatype dt, FLA_Dimension dim)
Definition: FLA_Blocksize.c:161
int F77_zunmlq(char *side, char *trans, int *m, int *n, int *k, dcomplex *a, int *lda, dcomplex *tau, dcomplex *c, int *ldc, dcomplex *work, int *lwork, int *info)
FLA_Datatype FLA_Obj_datatype(FLA_Obj obj)
Definition: FLA_Query.c:13
FLA_Error FLA_Apply_Q_check(FLA_Side side, FLA_Trans trans, FLA_Store storev, FLA_Obj A, FLA_Obj t, FLA_Obj B)
Definition: FLA_Apply_Q_check.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
Definition: blis_type_defs.h:132
int F77_sormlq(char *side, char *trans, int *m, int *n, int *k, float *a, int *lda, float *tau, float *c, int *ldc, float *work, int *lwork, int *info)
int F77_cunmlq(char *side, char *trans, int *m, int *n, int *k, scomplex *a, int *lda, scomplex *tau, scomplex *c, int *ldc, scomplex *work, int *lwork, int *info)
dim_t FLA_Obj_vector_dim(FLA_Obj obj)
Definition: FLA_Query.c:137
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_sormqr(char *side, char *trans, int *m, int *n, int *k, float *a, int *lda, float *tau, float *c, int *ldc, float *work, int *lwork, int *info)
dim_t FLA_Obj_length(FLA_Obj obj)
Definition: FLA_Query.c:116
int F77_dormlq(char *side, char *trans, int *m, int *n, int *k, double *a, int *lda, double *tau, double *c, int *ldc, double *work, int *lwork, int *info)
Definition: blis_type_defs.h:137
int F77_dormqr(char *side, char *trans, int *m, int *n, int *k, double *a, int *lda, double *tau, double *c, int *ldc, double *work, int *lwork, int *info)