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 )
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_Apply_Q_check
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
F77_dormqr
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)
F77_cunmlq
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)
F77_sormqr
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)
F77_zunmlq
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)
F77_zunmqr
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)
F77_sormlq
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)
F77_dormlq
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)
F77_cunmqr
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_Obj_width
dim_t FLA_Obj_width(FLA_Obj obj)
Definition FLA_Query.c:123
FLA_Obj_create
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_Obj_has_zero_dim
FLA_Bool FLA_Obj_has_zero_dim(FLA_Obj A)
Definition FLA_Query.c:400
FLA_Obj_length
dim_t FLA_Obj_length(FLA_Obj obj)
Definition FLA_Query.c:116
FLA_Obj_col_stride
dim_t FLA_Obj_col_stride(FLA_Obj obj)
Definition FLA_Query.c:174
FLA_Check_error_level
unsigned int FLA_Check_error_level(void)
Definition FLA_Check.c:18
FLA_Query_blocksize
dim_t FLA_Query_blocksize(FLA_Datatype dt, FLA_Dimension dim)
Definition FLA_Blocksize.c:161
FLA_Param_map_flame_to_netlib_trans
void FLA_Param_map_flame_to_netlib_trans(FLA_Trans trans, void *blas_trans)
Definition FLA_Param.c:15
FLA_Obj_free
FLA_Error FLA_Obj_free(FLA_Obj *obj)
Definition FLA_Obj.c:588
FLA_Param_map_flame_to_netlib_side
void FLA_Param_map_flame_to_netlib_side(FLA_Uplo side, void *blas_side)
Definition FLA_Param.c:71
FLA_Obj_vector_dim
dim_t FLA_Obj_vector_dim(FLA_Obj obj)
Definition FLA_Query.c:137
FLA_Obj_datatype
FLA_Datatype FLA_Obj_datatype(FLA_Obj obj)
Definition FLA_Query.c:13
FLA_Datatype
int FLA_Datatype
Definition FLA_type_defs.h:49
FLA_Obj_view
Definition FLA_type_defs.h:159
dcomplex
Definition blis_type_defs.h:138
scomplex
Definition blis_type_defs.h:133

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().

Generated on Thu Sep 23 2021 17:46:17 for libflame by doxygen 1.12.0