libflame  revision_anchor
Functions
FLA_Tridiag_form_Q_external.c File Reference

(r)

Functions

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

Function Documentation

◆ FLA_Tridiag_form_Q_external()

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

References F77_cungtr(), F77_dorgtr(), F77_sorgtr(), F77_zungtr(), 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_Param_map_flame_to_netlib_uplo(), FLA_Query_blocksize(), and FLA_Tridiag_form_Q_check().

14 {
15  int info = 0;
16 #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES
17  FLA_Datatype datatype;
18  int m_A;
19  int cs_A;
20  int lwork;
21  char blas_uplo;
22  FLA_Obj work;
23 
24  if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
25  FLA_Tridiag_form_Q_check( uplo, A, t );
26 
27  if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
28 
29  datatype = FLA_Obj_datatype( A );
30 
31  m_A = FLA_Obj_length( A );
32  cs_A = FLA_Obj_col_stride( A );
33 
34  FLA_Param_map_flame_to_netlib_uplo( uplo, &blas_uplo );
35 
36  lwork = max( 1, ( m_A - 1 ) ) * FLA_Query_blocksize( datatype, FLA_DIMENSION_MIN );
37 
38  FLA_Obj_create( datatype, lwork, 1, 0, 0, &work );
39 
40 
41  switch( datatype ){
42 
43  case FLA_FLOAT:
44  {
45  float* buff_A = ( float * ) FLA_FLOAT_PTR( A );
46  float* buff_t = ( float * ) FLA_FLOAT_PTR( t );
47  float* buff_work = ( float * ) FLA_FLOAT_PTR( work );
48 
49  F77_sorgtr( &blas_uplo,
50  &m_A,
51  buff_A, &cs_A,
52  buff_t,
53  buff_work, &lwork,
54  &info );
55 
56  break;
57  }
58 
59  case FLA_DOUBLE:
60  {
61  double* buff_A = ( double * ) FLA_DOUBLE_PTR( A );
62  double* buff_t = ( double * ) FLA_DOUBLE_PTR( t );
63  double* buff_work = ( double * ) FLA_DOUBLE_PTR( work );
64 
65  F77_dorgtr( &blas_uplo,
66  &m_A,
67  buff_A, &cs_A,
68  buff_t,
69  buff_work, &lwork,
70  &info );
71 
72  break;
73  }
74 
75  case FLA_COMPLEX:
76  {
77  scomplex* buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
78  scomplex* buff_t = ( scomplex * ) FLA_COMPLEX_PTR( t );
79  scomplex* buff_work = ( scomplex * ) FLA_COMPLEX_PTR( work );
80 
81  F77_cungtr( &blas_uplo,
82  &m_A,
83  buff_A, &cs_A,
84  buff_t,
85  buff_work, &lwork,
86  &info );
87 
88  break;
89  }
90 
91  case FLA_DOUBLE_COMPLEX:
92  {
93  dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
94  dcomplex *buff_t = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( t );
95  dcomplex *buff_work = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( work );
96 
97  F77_zungtr( &blas_uplo,
98  &m_A,
99  buff_A, &cs_A,
100  buff_t,
101  buff_work, &lwork,
102  &info );
103 
104  break;
105  }
106 
107  }
108 
109  FLA_Obj_free( &work );
110 #else
111  FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
112 #endif
113 
114  return info;
115 }
FLA_Error FLA_Tridiag_form_Q_check(FLA_Uplo uplo, FLA_Obj A, FLA_Obj t)
Definition: FLA_Tridiag_form_Q_check.c:13
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_zungtr(char *uplo, int *m, dcomplex *a, int *lda, dcomplex *tau, dcomplex *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_uplo(FLA_Uplo uplo, void *blas_uplo)
Definition: FLA_Param.c:47
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
int F77_cungtr(char *uplo, int *m, scomplex *a, int *lda, scomplex *tau, scomplex *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
int F77_sorgtr(char *uplo, int *m, float *a, int *lda, float *tau, float *work, int *lwork, int *info)
Definition: blis_type_defs.h:132
int F77_dorgtr(char *uplo, int *m, double *a, int *lda, double *tau, double *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
dim_t FLA_Obj_length(FLA_Obj obj)
Definition: FLA_Query.c:116
Definition: blis_type_defs.h:137