LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
lapack_int LAPACKE_zbbcsd_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,
lapack_complex_double *  u1,
lapack_int  ldu1,
lapack_complex_double *  u2,
lapack_int  ldu2,
lapack_complex_double *  v1t,
lapack_int  ldv1t,
lapack_complex_double *  v2t,
lapack_int  ldv2t,
double *  b11d,
double *  b11e,
double *  b12d,
double *  b12e,
double *  b21d,
double *  b21e,
double *  b22d,
double *  b22e,
double *  rwork,
lapack_int  lrwork 
)

Definition at line 36 of file lapacke_zbbcsd_work.c.

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

Here is the call graph for this function:

Here is the caller graph for this function: