libflame  revision_anchor
Functions
FLA_Tridiag_apply_Q_external.c File Reference

(r)

Functions

FLA_Error FLA_Tridiag_apply_Q_external (FLA_Side side, FLA_Uplo uplo, FLA_Trans trans, FLA_Obj A, FLA_Obj t, FLA_Obj B)
 

Function Documentation

◆ FLA_Tridiag_apply_Q_external()

FLA_Error FLA_Tridiag_apply_Q_external ( FLA_Side  side,
FLA_Uplo  uplo,
FLA_Trans  trans,
FLA_Obj  A,
FLA_Obj  t,
FLA_Obj  B 
)

References F77_cunmtr(), F77_dormtr(), F77_sormtr(), F77_zunmtr(), 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(), 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  // 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_uplo;
26  char blas_trans;
27  FLA_Obj work;
28  int i;
29 
30  //if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
31  // FLA_Apply_Q_check( side, trans, storev, A, t, B );
32 
33  if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
34 
35  datatype = FLA_Obj_datatype( A );
36 
37  // m_A = FLA_Obj_length( A );
38  // n_A = FLA_Obj_width( A );
39  cs_A = FLA_Obj_col_stride( A );
40 
41  m_B = FLA_Obj_length( B );
42  n_B = FLA_Obj_width( B );
43  cs_B = FLA_Obj_col_stride( B );
44 
45  k_t = FLA_Obj_vector_dim( t );
46 
47  FLA_Param_map_flame_to_netlib_side( side, &blas_side );
48  FLA_Param_map_flame_to_netlib_uplo( uplo, &blas_uplo );
49  FLA_Param_map_flame_to_netlib_trans( trans, &blas_trans );
50 
51 
52  // Make a workspace query the first time through. This will provide us with
53  // and ideal workspace size based on an internal block size.
54  lwork = -1;
55  FLA_Obj_create( datatype, 1, 1, 0, 0, &work );
56 
57  for ( i = 0; i < 2; ++i )
58  {
59  if ( i == 1 )
60  {
61  // Grab the queried ideal workspace size from the work array, free the
62  // work object, and then re-allocate the workspace with the ideal size.
63  if ( datatype == FLA_FLOAT || datatype == FLA_COMPLEX )
64  lwork = ( int ) *FLA_FLOAT_PTR( work );
65  else if ( datatype == FLA_DOUBLE || datatype == FLA_DOUBLE_COMPLEX )
66  lwork = ( int ) *FLA_DOUBLE_PTR( work );
67 
68  FLA_Obj_free( &work );
69  FLA_Obj_create( datatype, lwork, 1, 0, 0, &work );
70  }
71 
72  switch( datatype ){
73 
74  case FLA_FLOAT:
75  {
76  float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
77  float *buff_t = ( float * ) FLA_FLOAT_PTR( t );
78  float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
79  float *buff_work = ( float * ) FLA_FLOAT_PTR( work );
80 
81  F77_sormtr( &blas_side,
82  &blas_uplo,
83  &blas_trans,
84  &m_B,
85  &n_B,
86  buff_A, &cs_A,
87  buff_t,
88  buff_B, &cs_B,
89  buff_work, &lwork,
90  &info );
91 
92  break;
93  }
94 
95  case FLA_DOUBLE:
96  {
97  double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
98  double *buff_t = ( double * ) FLA_DOUBLE_PTR( t );
99  double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
100  double *buff_work = ( double * ) FLA_DOUBLE_PTR( work );
101 
102  F77_dormtr( &blas_side,
103  &blas_uplo,
104  &blas_trans,
105  &m_B,
106  &n_B,
107  buff_A, &cs_A,
108  buff_t,
109  buff_B, &cs_B,
110  buff_work, &lwork,
111  &info );
112 
113  break;
114  }
115 
116  case FLA_COMPLEX:
117  {
118  scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
119  scomplex *buff_t = ( scomplex * ) FLA_COMPLEX_PTR( t );
120  scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
121  scomplex *buff_work = ( scomplex * ) FLA_COMPLEX_PTR( work );
122 
123  F77_cunmtr( &blas_side,
124  &blas_uplo,
125  &blas_trans,
126  &m_B,
127  &n_B,
128  buff_A, &cs_A,
129  buff_t,
130  buff_B, &cs_B,
131  buff_work, &lwork,
132  &info );
133 
134  break;
135  }
136 
137  case FLA_DOUBLE_COMPLEX:
138  {
139  dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
140  dcomplex *buff_t = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( t );
141  dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
142  dcomplex *buff_work = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( work );
143 
144  F77_zunmtr( &blas_side,
145  &blas_uplo,
146  &blas_trans,
147  &m_B,
148  &n_B,
149  buff_A, &cs_A,
150  buff_t,
151  buff_B, &cs_B,
152  buff_work, &lwork,
153  &info );
154 
155  break;
156  }
157 
158  }
159  }
160 
161  FLA_Obj_free( &work );
162 #else
163  FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
164 #endif
165 
166  return info;
167 }
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_cunmtr(char *side, char *uplo, char *trans, int *m, int *n, 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
int F77_dormtr(char *side, char *uplo, char *trans, int *m, int *n, double *a, int *lda, double *tau, double *c, int *ldc, double *work, int *lwork, int *info)
void FLA_Param_map_flame_to_netlib_uplo(FLA_Uplo uplo, void *blas_uplo)
Definition: FLA_Param.c:47
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
int F77_sormtr(char *side, char *uplo, char *trans, int *m, int *n, float *a, int *lda, float *tau, float *c, int *ldc, float *work, int *lwork, int *info)
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
int F77_zunmtr(char *side, char *uplo, char *trans, int *m, int *n, dcomplex *a, int *lda, dcomplex *tau, dcomplex *c, int *ldc, dcomplex *work, int *lwork, int *info)
Definition: blis_type_defs.h:132
dim_t FLA_Obj_vector_dim(FLA_Obj obj)
Definition: FLA_Query.c:137
int FLA_Datatype
Definition: FLA_type_defs.h:49
dim_t FLA_Obj_col_stride(FLA_Obj obj)
Definition: FLA_Query.c:174
int i
Definition: bl1_axmyv2.c:145
dim_t FLA_Obj_length(FLA_Obj obj)
Definition: FLA_Query.c:116
Definition: blis_type_defs.h:137