LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ LAPACKE_dorcsd2by1_work()

lapack_int LAPACKE_dorcsd2by1_work ( int  matrix_layout,
char  jobu1,
char  jobu2,
char  jobv1t,
lapack_int  m,
lapack_int  p,
lapack_int  q,
double *  x11,
lapack_int  ldx11,
double *  x21,
lapack_int  ldx21,
double *  theta,
double *  u1,
lapack_int  ldu1,
double *  u2,
lapack_int  ldu2,
double *  v1t,
lapack_int  ldv1t,
double *  work,
lapack_int  lwork,
lapack_int *  iwork 
)

Definition at line 35 of file lapacke_dorcsd2by1_work.c.

43 {
44  lapack_int info = 0;
45  if( matrix_layout == LAPACK_COL_MAJOR ) {
46  /* Call LAPACK function and adjust info */
47  LAPACK_dorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p,
48  &q, x11, &ldx11, x21, &ldx21,
49  theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t,
50  work, &lwork, iwork, &info );
51  if( info < 0 ) {
52  info = info - 1;
53  }
54  } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
55  lapack_int nrows_x11 = p;
56  lapack_int nrows_x21 = m-p;
57  lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
58  lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
59  lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
60  lapack_int ldu1_t = MAX(1,nrows_u1);
61  lapack_int ldu2_t = MAX(1,nrows_u2);
62  lapack_int ldv1t_t = MAX(1,nrows_v1t);
63  lapack_int ldx11_t = MAX(1,nrows_x11);
64  lapack_int ldx21_t = MAX(1,nrows_x21);
65  double* x11_t = NULL;
66  double* x21_t = NULL;
67  double* u1_t = NULL;
68  double* u2_t = NULL;
69  double* v1t_t = NULL;
70  /* Check leading dimension(s) */
71  if( ldu1 < p ) {
72  info = -21;
73  LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info );
74  return info;
75  }
76  if( ldu2 < m-p ) {
77  info = -23;
78  LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info );
79  return info;
80  }
81  if( ldv1t < q ) {
82  info = -25;
83  LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info );
84  return info;
85  }
86  if( ldx11 < q ) {
87  info = -12;
88  LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info );
89  return info;
90  }
91  if( ldx21 < q ) {
92  info = -16;
93  LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info );
94  return info;
95  }
96  /* Query optimal working array(s) size if requested */
97  if( lwork == -1 ) {
98  LAPACK_dorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p,
99  &q, x11, &ldx11_t, x21, &ldx21_t,
100  theta, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
101  work, &lwork, iwork, &info );
102  return (info < 0) ? (info - 1) : info;
103  }
104  /* Allocate memory for temporary array(s) */
105  x11_t = (double*)LAPACKE_malloc( sizeof(double) * ldx11_t * MAX(1,q) );
106  if( x11_t == NULL ) {
107  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
108  goto exit_level_0;
109  }
110  x21_t = (double*)LAPACKE_malloc( sizeof(double) * ldx21_t * MAX(1,q) );
111  if( x21_t == NULL ) {
112  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
113  goto exit_level_1;
114  }
115  if( LAPACKE_lsame( jobu1, 'y' ) ) {
116  u1_t = (double*)
117  LAPACKE_malloc( sizeof(double) * ldu1_t * MAX(1,p) );
118  if( u1_t == NULL ) {
119  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
120  goto exit_level_2;
121  }
122  }
123  if( LAPACKE_lsame( jobu2, 'y' ) ) {
124  u2_t = (double*)
125  LAPACKE_malloc( sizeof(double) * ldu2_t * MAX(1,m-p) );
126  if( u2_t == NULL ) {
127  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
128  goto exit_level_3;
129  }
130  }
131  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
132  v1t_t = (double*)
133  LAPACKE_malloc( sizeof(double) * ldv1t_t * MAX(1,q) );
134  if( v1t_t == NULL ) {
135  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
136  goto exit_level_4;
137  }
138  }
139  /* Transpose input matrices */
140  LAPACKE_dge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
141  ldx11_t );
142  LAPACKE_dge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
143  ldx21_t );
144  /* Call LAPACK function and adjust info */
145  LAPACK_dorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p,
146  &q, x11_t, &ldx11_t, x21_t, &ldx21_t,
147  theta, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t, &ldv1t_t,
148  work, &lwork, iwork, &info );
149  if( info < 0 ) {
150  info = info - 1;
151  }
152  /* Transpose output matrices */
153  LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
154  ldx11 );
155  LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
156  ldx21 );
157  if( LAPACKE_lsame( jobu1, 'y' ) ) {
158  LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
159  ldu1 );
160  }
161  if( LAPACKE_lsame( jobu2, 'y' ) ) {
162  LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
163  u2, ldu2 );
164  }
165  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
166  LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
167  v1t, ldv1t );
168  }
169  /* Release memory and exit */
170  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
171  LAPACKE_free( v1t_t );
172  }
173 exit_level_4:
174  if( LAPACKE_lsame( jobu2, 'y' ) ) {
175  LAPACKE_free( u2_t );
176  }
177 exit_level_3:
178  if( LAPACKE_lsame( jobu1, 'y' ) ) {
179  LAPACKE_free( u1_t );
180  }
181 exit_level_2:
182  LAPACKE_free( x21_t );
183 exit_level_1:
184  LAPACKE_free( x11_t );
185 exit_level_0:
186  if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
187  LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info );
188  }
189  } else {
190  info = -1;
191  LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info );
192  }
193  return info;
194 }
lapack_int
#define lapack_int
Definition: lapack.h:83
LAPACK_dorcsd2by1
void LAPACK_dorcsd2by1(char const *jobu1, char const *jobu2, char const *jobv1t, lapack_int const *m, lapack_int const *p, lapack_int const *q, double *X11, lapack_int const *ldx11, double *X21, lapack_int const *ldx21, double *theta, double *U1, lapack_int const *ldu1, double *U2, lapack_int const *ldu2, double *V1T, lapack_int const *ldv1t, double *work, lapack_int const *lwork, lapack_int *iwork, lapack_int *info)
LAPACK_COL_MAJOR
#define LAPACK_COL_MAJOR
Definition: lapacke.h:53
LAPACKE_free
#define LAPACKE_free(p)
Definition: lapacke.h:46
LAPACK_ROW_MAJOR
#define LAPACK_ROW_MAJOR
Definition: lapacke.h:52
LAPACKE_malloc
#define LAPACKE_malloc(size)
Definition: lapacke.h:43
LAPACK_TRANSPOSE_MEMORY_ERROR
#define LAPACK_TRANSPOSE_MEMORY_ERROR
Definition: lapacke.h:56
LAPACKE_lsame
lapack_logical LAPACKE_lsame(char ca, char cb)
Definition: lapacke_lsame.c:35
LAPACKE_xerbla
void LAPACKE_xerbla(const char *name, lapack_int info)
Definition: lapacke_xerbla.c:36
MAX
#define MAX(x, y)
Definition: lapacke_utils.h:46
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:39
Here is the call graph for this function:
Here is the caller graph for this function: