LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ LAPACKE_cbdsqr_work()

lapack_int LAPACKE_cbdsqr_work ( int  matrix_layout,
char  uplo,
lapack_int  n,
lapack_int  ncvt,
lapack_int  nru,
lapack_int  ncc,
float *  d,
float *  e,
lapack_complex_float vt,
lapack_int  ldvt,
lapack_complex_float u,
lapack_int  ldu,
lapack_complex_float c,
lapack_int  ldc,
float *  work 
)

Definition at line 35 of file lapacke_cbdsqr_work.c.

41{
42 lapack_int info = 0;
43 if( matrix_layout == LAPACK_COL_MAJOR ) {
44 /* Call LAPACK function and adjust info */
45 LAPACK_cbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt, &ldvt, u, &ldu,
46 c, &ldc, work, &info );
47 if( info < 0 ) {
48 info = info - 1;
49 }
50 } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
51 lapack_int ldc_t = MAX(1,n);
52 lapack_int ldu_t = MAX(1,nru);
53 lapack_int ldvt_t = MAX(1,n);
54 lapack_complex_float* vt_t = NULL;
55 lapack_complex_float* u_t = NULL;
56 lapack_complex_float* c_t = NULL;
57 /* Check leading dimension(s) */
58 if( ldc < ncc ) {
59 info = -14;
60 LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info );
61 return info;
62 }
63 if( ldu < n ) {
64 info = -12;
65 LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info );
66 return info;
67 }
68 if( ldvt < ncvt ) {
69 info = -10;
70 LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info );
71 return info;
72 }
73 /* Allocate memory for temporary array(s) */
74 if( ncvt != 0 ) {
75 vt_t = (lapack_complex_float*)
77 ldvt_t * MAX(1,ncvt) );
78 if( vt_t == NULL ) {
80 goto exit_level_0;
81 }
82 }
83 if( nru != 0 ) {
86 ldu_t * MAX(1,n) );
87 if( u_t == NULL ) {
89 goto exit_level_1;
90 }
91 }
92 if( ncc != 0 ) {
95 ldc_t * MAX(1,ncc) );
96 if( c_t == NULL ) {
98 goto exit_level_2;
99 }
100 }
101 /* Transpose input matrices */
102 if( ncvt != 0 ) {
103 LAPACKE_cge_trans( matrix_layout, n, ncvt, vt, ldvt, vt_t, ldvt_t );
104 }
105 if( nru != 0 ) {
106 LAPACKE_cge_trans( matrix_layout, nru, n, u, ldu, u_t, ldu_t );
107 }
108 if( ncc != 0 ) {
109 LAPACKE_cge_trans( matrix_layout, n, ncc, c, ldc, c_t, ldc_t );
110 }
111 /* Call LAPACK function and adjust info */
112 LAPACK_cbdsqr( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt_t, &ldvt_t, u_t,
113 &ldu_t, c_t, &ldc_t, work, &info );
114 if( info < 0 ) {
115 info = info - 1;
116 }
117 /* Transpose output matrices */
118 if( ncvt != 0 ) {
119 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_t, ldvt_t, vt,
120 ldvt );
121 }
122 if( nru != 0 ) {
123 LAPACKE_cge_trans( LAPACK_COL_MAJOR, nru, n, u_t, ldu_t, u, ldu );
124 }
125 if( ncc != 0 ) {
126 LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncc, c_t, ldc_t, c, ldc );
127 }
128 /* Release memory and exit */
129 if( ncc != 0 ) {
130 LAPACKE_free( c_t );
131 }
132exit_level_2:
133 if( nru != 0 ) {
134 LAPACKE_free( u_t );
135 }
136exit_level_1:
137 if( ncvt != 0 ) {
138 LAPACKE_free( vt_t );
139 }
140exit_level_0:
141 if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
142 LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info );
143 }
144 } else {
145 info = -1;
146 LAPACKE_xerbla( "LAPACKE_cbdsqr_work", info );
147 }
148 return info;
149}
#define LAPACK_cbdsqr(...)
Definition: lapack.h:330
#define lapack_int
Definition: lapack.h:87
#define lapack_complex_float
Definition: lapack.h:46
#define LAPACK_COL_MAJOR
Definition: lapacke.h:53
#define LAPACKE_free(p)
Definition: lapacke.h:46
#define LAPACK_ROW_MAJOR
Definition: lapacke.h:52
#define LAPACKE_malloc(size)
Definition: lapacke.h:43
#define LAPACK_TRANSPOSE_MEMORY_ERROR
Definition: lapacke.h:56
void LAPACKE_xerbla(const char *name, lapack_int info)
#define MAX(x, y)
Definition: lapacke_utils.h:46
void LAPACKE_cge_trans(int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout)
Here is the call graph for this function:
Here is the caller graph for this function: