LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
lapacke_zuncsd_work.c
Go to the documentation of this file.
1 /*****************************************************************************
2  Copyright (c) 2014, Intel Corp.
3  All rights reserved.
4 
5  Redistribution and use in source and binary forms, with or without
6  modification, are permitted provided that the following conditions are met:
7 
8  * Redistributions of source code must retain the above copyright notice,
9  this list of conditions and the following disclaimer.
10  * Redistributions in binary form must reproduce the above copyright
11  notice, this list of conditions and the following disclaimer in the
12  documentation and/or other materials provided with the distribution.
13  * Neither the name of Intel Corporation nor the names of its contributors
14  may be used to endorse or promote products derived from this software
15  without specific prior written permission.
16 
17  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
21  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
22  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
23  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
25  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
26  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
27  THE POSSIBILITY OF SUCH DAMAGE.
28 *****************************************************************************
29 * Contents: Native middle-level C interface to LAPACK function zuncsd
30 * Author: Intel Corporation
31 * Generated November 2015
32 *****************************************************************************/
33 
34 #include "lapacke_utils.h"
35 
36 lapack_int LAPACKE_zuncsd_work( int matrix_layout, char jobu1, char jobu2,
37  char jobv1t, char jobv2t, char trans,
38  char signs, lapack_int m, lapack_int p,
39  lapack_int q, lapack_complex_double* x11,
40  lapack_int ldx11, lapack_complex_double* x12,
41  lapack_int ldx12, lapack_complex_double* x21,
42  lapack_int ldx21, lapack_complex_double* x22,
43  lapack_int ldx22, double* theta,
44  lapack_complex_double* u1, lapack_int ldu1,
45  lapack_complex_double* u2, lapack_int ldu2,
46  lapack_complex_double* v1t, lapack_int ldv1t,
47  lapack_complex_double* v2t, lapack_int ldv2t,
48  lapack_complex_double* work, lapack_int lwork,
49  double* rwork, lapack_int lrwork,
50  lapack_int* iwork )
51 {
52  lapack_int info = 0;
53  if( matrix_layout == LAPACK_COL_MAJOR ) {
54  /* Call LAPACK function and adjust info */
55  LAPACK_zuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
56  &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22, &ldx22,
57  theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t, &ldv2t,
58  work, &lwork, rwork, &lrwork, iwork, &info );
59  if( info < 0 ) {
60  info = info - 1;
61  }
62  } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
63  lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
64  lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
65  lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
66  lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
67  lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
68  lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
69  lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
70  lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
71  lapack_int ldu1_t = MAX(1,nrows_u1);
72  lapack_int ldu2_t = MAX(1,nrows_u2);
73  lapack_int ldv1t_t = MAX(1,nrows_v1t);
74  lapack_int ldv2t_t = MAX(1,nrows_v2t);
75  lapack_int ldx11_t = MAX(1,nrows_x11);
76  lapack_int ldx12_t = MAX(1,nrows_x12);
77  lapack_int ldx21_t = MAX(1,nrows_x21);
78  lapack_int ldx22_t = MAX(1,nrows_x22);
79  lapack_complex_double* x11_t = NULL;
80  lapack_complex_double* x12_t = NULL;
81  lapack_complex_double* x21_t = NULL;
82  lapack_complex_double* x22_t = NULL;
83  lapack_complex_double* u1_t = NULL;
84  lapack_complex_double* u2_t = NULL;
85  lapack_complex_double* v1t_t = NULL;
86  lapack_complex_double* v2t_t = NULL;
87  /* Check leading dimension(s) */
88  if( ldu1 < p ) {
89  info = -21;
90  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
91  return info;
92  }
93  if( ldu2 < m-p ) {
94  info = -23;
95  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
96  return info;
97  }
98  if( ldv1t < q ) {
99  info = -25;
100  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
101  return info;
102  }
103  if( ldv2t < m-q ) {
104  info = -27;
105  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
106  return info;
107  }
108  if( ldx11 < q ) {
109  info = -12;
110  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
111  return info;
112  }
113  if( ldx12 < m-q ) {
114  info = -14;
115  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
116  return info;
117  }
118  if( ldx21 < q ) {
119  info = -16;
120  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
121  return info;
122  }
123  if( ldx22 < m-q ) {
124  info = -18;
125  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
126  return info;
127  }
128  /* Query optimal working array(s) size if requested */
129  if( lrwork == -1 || lwork == -1 ) {
130  LAPACK_zuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m,
131  &p, &q, x11, &ldx11_t, x12, &ldx12_t, x21, &ldx21_t,
132  x22, &ldx22_t, theta, u1, &ldu1_t, u2, &ldu2_t, v1t,
133  &ldv1t_t, v2t, &ldv2t_t, work, &lwork, rwork,
134  &lrwork, iwork, &info );
135  return (info < 0) ? (info - 1) : info;
136  }
137  /* Allocate memory for temporary array(s) */
138  x11_t = (lapack_complex_double*)
139  LAPACKE_malloc( sizeof(lapack_complex_double) *
140  ldx11_t * MAX(1,q) );
141  if( x11_t == NULL ) {
142  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
143  goto exit_level_0;
144  }
145  x12_t = (lapack_complex_double*)
146  LAPACKE_malloc( sizeof(lapack_complex_double) *
147  ldx12_t * MAX(1,m-q) );
148  if( x12_t == NULL ) {
149  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
150  goto exit_level_1;
151  }
152  x21_t = (lapack_complex_double*)
153  LAPACKE_malloc( sizeof(lapack_complex_double) *
154  ldx21_t * MAX(1,q) );
155  if( x21_t == NULL ) {
156  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
157  goto exit_level_2;
158  }
159  x22_t = (lapack_complex_double*)
160  LAPACKE_malloc( sizeof(lapack_complex_double) *
161  ldx22_t * MAX(1,m-q) );
162  if( x22_t == NULL ) {
163  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
164  goto exit_level_3;
165  }
166  if( LAPACKE_lsame( jobu1, 'y' ) ) {
167  u1_t = (lapack_complex_double*)
168  LAPACKE_malloc( sizeof(lapack_complex_double) *
169  ldu1_t * MAX(1,p) );
170  if( u1_t == NULL ) {
171  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
172  goto exit_level_4;
173  }
174  }
175  if( LAPACKE_lsame( jobu2, 'y' ) ) {
176  u2_t = (lapack_complex_double*)
177  LAPACKE_malloc( sizeof(lapack_complex_double) *
178  ldu2_t * MAX(1,m-p) );
179  if( u2_t == NULL ) {
180  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
181  goto exit_level_5;
182  }
183  }
184  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
185  v1t_t = (lapack_complex_double*)
186  LAPACKE_malloc( sizeof(lapack_complex_double) *
187  ldv1t_t * MAX(1,q) );
188  if( v1t_t == NULL ) {
189  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
190  goto exit_level_6;
191  }
192  }
193  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
194  v2t_t = (lapack_complex_double*)
195  LAPACKE_malloc( sizeof(lapack_complex_double) *
196  ldv2t_t * MAX(1,m-q) );
197  if( v2t_t == NULL ) {
198  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
199  goto exit_level_7;
200  }
201  }
202  /* Transpose input matrices */
203  LAPACKE_zge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
204  ldx11_t );
205  LAPACKE_zge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
206  ldx12_t );
207  LAPACKE_zge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
208  ldx21_t );
209  LAPACKE_zge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
210  ldx22_t );
211  /* Call LAPACK function and adjust info */
212  LAPACK_zuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
213  &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t,
214  x22_t, &ldx22_t, theta, u1_t, &ldu1_t, u2_t, &ldu2_t,
215  v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, work, &lwork, rwork,
216  &lrwork, iwork, &info );
217  if( info < 0 ) {
218  info = info - 1;
219  }
220  /* Transpose output matrices */
221  LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
222  ldx11 );
223  LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
224  x12, ldx12 );
225  LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
226  ldx21 );
227  LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
228  x22, ldx22 );
229  if( LAPACKE_lsame( jobu1, 'y' ) ) {
230  LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
231  ldu1 );
232  }
233  if( LAPACKE_lsame( jobu2, 'y' ) ) {
234  LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
235  u2, ldu2 );
236  }
237  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
238  LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
239  v1t, ldv1t );
240  }
241  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
242  LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
243  v2t, ldv2t );
244  }
245  /* Release memory and exit */
246  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
247  LAPACKE_free( v2t_t );
248  }
249 exit_level_7:
250  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
251  LAPACKE_free( v1t_t );
252  }
253 exit_level_6:
254  if( LAPACKE_lsame( jobu2, 'y' ) ) {
255  LAPACKE_free( u2_t );
256  }
257 exit_level_5:
258  if( LAPACKE_lsame( jobu1, 'y' ) ) {
259  LAPACKE_free( u1_t );
260  }
261 exit_level_4:
262  LAPACKE_free( x22_t );
263 exit_level_3:
264  LAPACKE_free( x21_t );
265 exit_level_2:
266  LAPACKE_free( x12_t );
267 exit_level_1:
268  LAPACKE_free( x11_t );
269 exit_level_0:
270  if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
271  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
272  }
273  } else {
274  info = -1;
275  LAPACKE_xerbla( "LAPACKE_zuncsd_work", info );
276  }
277  return info;
278 }
LAPACK_zuncsd
void LAPACK_zuncsd(char *jobu1, char *jobu2, char *jobv1t, char *jobv2t, char *trans, char *signs, lapack_int *m, lapack_int *p, lapack_int *q, lapack_complex_double *x11, lapack_int *ldx11, lapack_complex_double *x12, lapack_int *ldx12, lapack_complex_double *x21, lapack_int *ldx21, lapack_complex_double *x22, lapack_int *ldx22, double *theta, 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, lapack_complex_double *work, lapack_int *lwork, double *rwork, lapack_int *lrwork, lapack_int *iwork, lapack_int *info)
LAPACK_ROW_MAJOR
#define LAPACK_ROW_MAJOR
Definition: lapacke.h:119
lapack_complex_double
#define lapack_complex_double
Definition: lapacke.h:90
lapacke_utils.h
LAPACKE_zuncsd_work
lapack_int LAPACKE_zuncsd_work(int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double *x11, lapack_int ldx11, lapack_complex_double *x12, lapack_int ldx12, lapack_complex_double *x21, lapack_int ldx21, lapack_complex_double *x22, lapack_int ldx22, double *theta, 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, lapack_complex_double *work, lapack_int lwork, double *rwork, lapack_int lrwork, lapack_int *iwork)
Definition: lapacke_zuncsd_work.c:36
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_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