FLA_Bidiag_form_V_external.c File Reference
(r)
Functions | |
| FLA_Error | FLA_Bidiag_form_V_external (FLA_Obj A, FLA_Obj t) |
Function Documentation
◆ FLA_Bidiag_form_V_external()
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 = 'P';
25
27 FLA_Bidiag_form_V_check( A, t );
28
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
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
48 {
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 {
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 {
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_V_check(FLA_Obj A, FLA_Obj t)
Definition FLA_Bidiag_form_V_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)
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
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_V_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.
Generated on Thu Sep 23 2021 17:46:17 for libflame by
1.12.0