LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
lapack_int LAPACKE_sbbcsd_work ( int  matrix_layout,
char  jobu1,
char  jobu2,
char  jobv1t,
char  jobv2t,
char  trans,
lapack_int  m,
lapack_int  p,
lapack_int  q,
float *  theta,
float *  phi,
float *  u1,
lapack_int  ldu1,
float *  u2,
lapack_int  ldu2,
float *  v1t,
lapack_int  ldv1t,
float *  v2t,
lapack_int  ldv2t,
float *  b11d,
float *  b11e,
float *  b12d,
float *  b12e,
float *  b21d,
float *  b21e,
float *  b22d,
float *  b22e,
float *  work,
lapack_int  lwork 
)

Definition at line 36 of file lapacke_sbbcsd_work.c.

46 {
47  lapack_int info = 0;
48  if( matrix_layout == LAPACK_COL_MAJOR ) {
49  /* Call LAPACK function and adjust info */
50  LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
51  theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
52  &ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e,
53  work, &lwork, &info );
54  if( info < 0 ) {
55  info = info - 1;
56  }
57  } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
58  lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
59  lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
60  lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
61  lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
62  lapack_int ldu1_t = MAX(1,nrows_u1);
63  lapack_int ldu2_t = MAX(1,nrows_u2);
64  lapack_int ldv1t_t = MAX(1,nrows_v1t);
65  lapack_int ldv2t_t = MAX(1,nrows_v2t);
66  float* u1_t = NULL;
67  float* u2_t = NULL;
68  float* v1t_t = NULL;
69  float* v2t_t = NULL;
70  /* Check leading dimension(s) */
71  if( ldu1 < p ) {
72  info = -13;
73  LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
74  return info;
75  }
76  if( ldu2 < m-p ) {
77  info = -15;
78  LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
79  return info;
80  }
81  if( ldv1t < q ) {
82  info = -17;
83  LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
84  return info;
85  }
86  if( ldv2t < m-q ) {
87  info = -19;
88  LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
89  return info;
90  }
91  /* Query optimal working array(s) size if requested */
92  if( lwork == -1 ) {
93  LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
94  theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
95  v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e,
96  b22d, b22e, work, &lwork, &info );
97  return (info < 0) ? (info - 1) : info;
98  }
99  /* Allocate memory for temporary array(s) */
100  if( LAPACKE_lsame( jobu1, 'y' ) ) {
101  u1_t = (float*)LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) );
102  if( u1_t == NULL ) {
103  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
104  goto exit_level_0;
105  }
106  }
107  if( LAPACKE_lsame( jobu2, 'y' ) ) {
108  u2_t = (float*)
109  LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) );
110  if( u2_t == NULL ) {
111  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
112  goto exit_level_1;
113  }
114  }
115  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
116  v1t_t = (float*)
117  LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) );
118  if( v1t_t == NULL ) {
119  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
120  goto exit_level_2;
121  }
122  }
123  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
124  v2t_t = (float*)
125  LAPACKE_malloc( sizeof(float) * ldv2t_t * MAX(1,m-q) );
126  if( v2t_t == NULL ) {
127  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
128  goto exit_level_3;
129  }
130  }
131  /* Transpose input matrices */
132  if( LAPACKE_lsame( jobu1, 'y' ) ) {
133  LAPACKE_sge_trans( matrix_layout, nrows_u1, p, u1, ldu1, u1_t,
134  ldu1_t );
135  }
136  if( LAPACKE_lsame( jobu2, 'y' ) ) {
137  LAPACKE_sge_trans( matrix_layout, nrows_u2, m-p, u2, ldu2, u2_t,
138  ldu2_t );
139  }
140  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
141  LAPACKE_sge_trans( matrix_layout, nrows_v1t, q, v1t, ldv1t, v1t_t,
142  ldv1t_t );
143  }
144  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
145  LAPACKE_sge_trans( matrix_layout, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
146  ldv2t_t );
147  }
148  /* Call LAPACK function and adjust info */
149  LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
150  theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
151  &ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
152  b21e, b22d, b22e, work, &lwork, &info );
153  if( info < 0 ) {
154  info = info - 1;
155  }
156  /* Transpose output matrices */
157  if( LAPACKE_lsame( jobu1, 'y' ) ) {
158  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
159  ldu1 );
160  }
161  if( LAPACKE_lsame( jobu2, 'y' ) ) {
162  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
163  u2, ldu2 );
164  }
165  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
166  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
167  v1t, ldv1t );
168  }
169  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
170  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
171  v2t, ldv2t );
172  }
173  /* Release memory and exit */
174  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
175  LAPACKE_free( v2t_t );
176  }
177 exit_level_3:
178  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
179  LAPACKE_free( v1t_t );
180  }
181 exit_level_2:
182  if( LAPACKE_lsame( jobu2, 'y' ) ) {
183  LAPACKE_free( u2_t );
184  }
185 exit_level_1:
186  if( LAPACKE_lsame( jobu1, 'y' ) ) {
187  LAPACKE_free( u1_t );
188  }
189 exit_level_0:
190  if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
191  LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
192  }
193  } else {
194  info = -1;
195  LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
196  }
197  return info;
198 }
LAPACK_ROW_MAJOR
#define LAPACK_ROW_MAJOR
Definition: lapacke.h:119
LAPACKE_sge_trans
void LAPACKE_sge_trans(int matrix_layout, lapack_int m, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout)
Definition: lapacke_sge_trans.c:40
MAX
#define MAX(x, y)
Definition: lapacke_utils.h:47
LAPACKE_free
#define LAPACKE_free(p)
Definition: lapacke.h:113
LAPACKE_malloc
#define LAPACKE_malloc(size)
Definition: lapacke.h:110
LAPACKE_lsame
lapack_logical LAPACKE_lsame(char ca, char cb)
Definition: lapacke_lsame.c:36
LAPACK_sbbcsd
void LAPACK_sbbcsd(char *jobu1, char *jobu2, char *jobv1t, char *jobv2t, char *trans, lapack_int *m, lapack_int *p, lapack_int *q, float *theta, float *phi, float *u1, lapack_int *ldu1, float *u2, lapack_int *ldu2, float *v1t, lapack_int *ldv1t, float *v2t, lapack_int *ldv2t, float *b11d, float *b11e, float *b12d, float *b12e, float *b21d, float *b21e, float *b22d, float *b22e, float *work, lapack_int *lwork, lapack_int *info)
LAPACK_COL_MAJOR
#define LAPACK_COL_MAJOR
Definition: lapacke.h:120
LAPACKE_xerbla
void LAPACKE_xerbla(const char *name, lapack_int info)
Definition: lapacke_xerbla.c:37
lapack_int
#define lapack_int
Definition: lapacke.h:47
LAPACK_TRANSPOSE_MEMORY_ERROR
#define LAPACK_TRANSPOSE_MEMORY_ERROR
Definition: lapacke.h:123

Here is the call graph for this function:

Here is the caller graph for this function: