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

Definition at line 36 of file lapacke_dbbcsd_work.c.

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