libflame  revision_anchor
Functions
FLA_Bsvd_external.c File Reference

(r)

Functions

FLA_Error FLA_Bsvd_external (FLA_Uplo uplo, FLA_Obj d, FLA_Obj e, FLA_Obj U, FLA_Obj V)
 

Function Documentation

◆ FLA_Bsvd_external()

FLA_Error FLA_Bsvd_external ( FLA_Uplo  uplo,
FLA_Obj  d,
FLA_Obj  e,
FLA_Obj  U,
FLA_Obj  V 
)

References F77_cbdsqr(), F77_dbdsqr(), F77_sbdsqr(), F77_zbdsqr(), FLA_Obj_col_stride(), FLA_Obj_create(), FLA_Obj_datatype(), FLA_Obj_datatype_proj_to_real(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_vector_inc(), and FLA_Param_map_flame_to_netlib_uplo().

14 {
15  int info = 0;
16 #ifdef FLA_ENABLE_EXTERNAL_LAPACK_INTERFACES
17  FLA_Datatype datatype;
18  FLA_Datatype dt_real;
19  int m_U, cs_U;
20  int n_V, cs_V;
21  int n_C, cs_C;
22  int min_m_n;
23  int inc_d, inc_e;
24  int lrwork;
25  FLA_Obj rwork;
26  char blas_uplo;
27 
28  //if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
29  // FLA_Hevd_check( jobz, uplo, A, e );
30 
31  if ( FLA_Obj_has_zero_dim( d ) ) return FLA_SUCCESS;
32 
33  datatype = FLA_Obj_datatype( U );
34  dt_real = FLA_Obj_datatype_proj_to_real( U );
35 
36  m_U = FLA_Obj_length( U );
37  cs_U = FLA_Obj_col_stride( U );
38 
39  n_V = FLA_Obj_length( V );
40  cs_V = FLA_Obj_col_stride( V );
41 
42  n_C = 0;
43  cs_C = 1;
44 
45  min_m_n = FLA_Obj_vector_dim( d );
46 
47  inc_d = FLA_Obj_vector_inc( d );
48  inc_e = FLA_Obj_vector_inc( e );
49 
50  lrwork = max( 1, 4 * min_m_n - 4 );
51  FLA_Obj_create( dt_real, lrwork, 1, 0, 0, &rwork );
52 
53  FLA_Param_map_flame_to_netlib_uplo( uplo, &blas_uplo );
54 
55  switch( datatype ) {
56 
57  case FLA_FLOAT:
58  {
59  float* buff_d = ( float * ) FLA_FLOAT_PTR( d );
60  float* buff_e = ( float * ) FLA_FLOAT_PTR( e );
61  float* buff_U = ( float * ) FLA_FLOAT_PTR( U );
62  float* buff_V = ( float * ) FLA_FLOAT_PTR( V );
63  float* buff_C = ( float * ) NULL;
64  float* buff_rwork = ( float * ) FLA_FLOAT_PTR( rwork );
65 
66  F77_sbdsqr( &blas_uplo,
67  &min_m_n,
68  &n_V,
69  &m_U,
70  &n_C,
71  buff_d,
72  buff_e,
73  buff_V, &cs_V,
74  buff_U, &cs_U,
75  buff_C, &cs_C,
76  buff_rwork,
77  &info );
78 
79  break;
80  }
81 
82  case FLA_DOUBLE:
83  {
84  double* buff_d = ( double * ) FLA_DOUBLE_PTR( d );
85  double* buff_e = ( double * ) FLA_DOUBLE_PTR( e );
86  double* buff_U = ( double * ) FLA_DOUBLE_PTR( U );
87  double* buff_V = ( double * ) FLA_DOUBLE_PTR( V );
88  double* buff_C = ( double * ) NULL;
89  double* buff_rwork = ( double * ) FLA_DOUBLE_PTR( rwork );
90 
91  F77_dbdsqr( &blas_uplo,
92  &min_m_n,
93  &n_V,
94  &m_U,
95  &n_C,
96  buff_d,
97  buff_e,
98  buff_V, &cs_V,
99  buff_U, &cs_U,
100  buff_C, &cs_C,
101  buff_rwork,
102  &info );
103 
104  break;
105  }
106 
107  case FLA_COMPLEX:
108  {
109  float* buff_d = ( float * ) FLA_FLOAT_PTR( d );
110  float* buff_e = ( float * ) FLA_FLOAT_PTR( e );
111  scomplex* buff_U = ( scomplex * ) FLA_COMPLEX_PTR( U );
112  scomplex* buff_V = ( scomplex * ) FLA_COMPLEX_PTR( V );
113  scomplex* buff_C = ( scomplex * ) NULL;
114  float* buff_rwork = ( float * ) FLA_FLOAT_PTR( rwork );
115 
116  F77_cbdsqr( &blas_uplo,
117  &min_m_n,
118  &n_V,
119  &m_U,
120  &n_C,
121  buff_d,
122  buff_e,
123  buff_V, &cs_V,
124  buff_U, &cs_U,
125  buff_C, &cs_C,
126  buff_rwork,
127  &info );
128 
129  break;
130  }
131 
132  case FLA_DOUBLE_COMPLEX:
133  {
134  double* buff_d = ( double * ) FLA_DOUBLE_PTR( d );
135  double* buff_e = ( double * ) FLA_DOUBLE_PTR( e );
136  dcomplex* buff_U = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( U );
137  dcomplex* buff_V = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( V );
138  dcomplex* buff_C = ( dcomplex * ) NULL;
139  double* buff_rwork = ( double * ) FLA_DOUBLE_PTR( rwork );
140 
141  F77_zbdsqr( &blas_uplo,
142  &min_m_n,
143  &n_V,
144  &m_U,
145  &n_C,
146  buff_d,
147  buff_e,
148  buff_V, &cs_V,
149  buff_U, &cs_U,
150  buff_C, &cs_C,
151  buff_rwork,
152  &info );
153 
154  break;
155  }
156 
157  }
158 
159  FLA_Obj_free( &rwork );
160 
161 #else
162  FLA_Check_error_code( FLA_EXTERNAL_LAPACK_NOT_IMPLEMENTED );
163 #endif
164 
165  return info;
166 }
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_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
int F77_zbdsqr(char *uplo, int *n, int *ncvt, int *nru, int *ncc, double *d, double *e, dcomplex *vt, int *ldvt, dcomplex *u, int *ldu, dcomplex *c, int *ldc, double *rwork, 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
FLA_Datatype FLA_Obj_datatype_proj_to_real(FLA_Obj A)
Definition: FLA_Query.c:23
int F77_sbdsqr(char *uplo, int *n, int *ncvt, int *nru, int *ncc, float *d, float *e, float *vt, int *ldvt, float *u, int *ldu, float *c, int *ldc, float *rwork, 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 F77_cbdsqr(char *uplo, int *n, int *ncvt, int *nru, int *ncc, float *d, float *e, scomplex *vt, int *ldvt, scomplex *u, int *ldu, scomplex *c, int *ldc, float *rwork, int *info)
dim_t FLA_Obj_vector_inc(FLA_Obj obj)
Definition: FLA_Query.c:145
int F77_dbdsqr(char *uplo, int *n, int *ncvt, int *nru, int *ncc, double *d, double *e, double *vt, int *ldvt, double *u, int *ldu, double *c, int *ldc, double *rwork, int *info)
dim_t FLA_Obj_length(FLA_Obj obj)
Definition: FLA_Query.c:116
Definition: blis_type_defs.h:137