LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
lapacke_cuncsd_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 cuncsd
30 * Author: Intel Corporation
31 * Generated November 2015
32 *****************************************************************************/
33 
34 #include "lapacke_utils.h"
35 
36 lapack_int LAPACKE_cuncsd_work( int matrix_layout, char jobu1, char jobu2,
37  char jobv1t, char jobv2t, char trans,
38  char signs, lapack_int m, lapack_int p,
40  lapack_int ldx11, lapack_complex_float* x12,
41  lapack_int ldx12, lapack_complex_float* x21,
42  lapack_int ldx21, lapack_complex_float* x22,
43  lapack_int ldx22, float* theta,
46  lapack_complex_float* v1t, lapack_int ldv1t,
47  lapack_complex_float* v2t, lapack_int ldv2t,
48  lapack_complex_float* work, lapack_int lwork,
49  float* 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_cuncsd( &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_float* x11_t = NULL;
80  lapack_complex_float* x12_t = NULL;
81  lapack_complex_float* x21_t = NULL;
82  lapack_complex_float* x22_t = NULL;
83  lapack_complex_float* u1_t = NULL;
84  lapack_complex_float* u2_t = NULL;
85  lapack_complex_float* v1t_t = NULL;
86  lapack_complex_float* v2t_t = NULL;
87  /* Check leading dimension(s) */
88  if( ldu1 < p ) {
89  info = -21;
90  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
91  return info;
92  }
93  if( ldu2 < m-p ) {
94  info = -23;
95  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
96  return info;
97  }
98  if( ldv1t < q ) {
99  info = -25;
100  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
101  return info;
102  }
103  if( ldv2t < m-q ) {
104  info = -27;
105  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
106  return info;
107  }
108  if( ldx11 < q ) {
109  info = -12;
110  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
111  return info;
112  }
113  if( ldx12 < m-q ) {
114  info = -14;
115  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
116  return info;
117  }
118  if( ldx21 < q ) {
119  info = -16;
120  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
121  return info;
122  }
123  if( ldx22 < m-q ) {
124  info = -18;
125  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
126  return info;
127  }
128  /* Query optimal working array(s) size if requested */
129  if( lrwork == -1 || lwork == -1 ) {
130  LAPACK_cuncsd( &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_float*)
139  LAPACKE_malloc( sizeof(lapack_complex_float) * ldx11_t * MAX(1,q) );
140  if( x11_t == NULL ) {
142  goto exit_level_0;
143  }
144  x12_t = (lapack_complex_float*)
146  ldx12_t * MAX(1,m-q) );
147  if( x12_t == NULL ) {
149  goto exit_level_1;
150  }
151  x21_t = (lapack_complex_float*)
152  LAPACKE_malloc( sizeof(lapack_complex_float) * ldx21_t * MAX(1,q) );
153  if( x21_t == NULL ) {
155  goto exit_level_2;
156  }
157  x22_t = (lapack_complex_float*)
159  ldx22_t * MAX(1,m-q) );
160  if( x22_t == NULL ) {
162  goto exit_level_3;
163  }
164  if( LAPACKE_lsame( jobu1, 'y' ) ) {
165  u1_t = (lapack_complex_float*)
167  ldu1_t * MAX(1,p) );
168  if( u1_t == NULL ) {
170  goto exit_level_4;
171  }
172  }
173  if( LAPACKE_lsame( jobu2, 'y' ) ) {
174  u2_t = (lapack_complex_float*)
176  ldu2_t * MAX(1,m-p) );
177  if( u2_t == NULL ) {
179  goto exit_level_5;
180  }
181  }
182  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
183  v1t_t = (lapack_complex_float*)
185  ldv1t_t * MAX(1,q) );
186  if( v1t_t == NULL ) {
188  goto exit_level_6;
189  }
190  }
191  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
192  v2t_t = (lapack_complex_float*)
194  ldv2t_t * MAX(1,m-q) );
195  if( v2t_t == NULL ) {
197  goto exit_level_7;
198  }
199  }
200  /* Transpose input matrices */
201  LAPACKE_cge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
202  ldx11_t );
203  LAPACKE_cge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
204  ldx12_t );
205  LAPACKE_cge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
206  ldx21_t );
207  LAPACKE_cge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
208  ldx22_t );
209  /* Call LAPACK function and adjust info */
210  LAPACK_cuncsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
211  &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t,
212  x22_t, &ldx22_t, theta, u1_t, &ldu1_t, u2_t, &ldu2_t,
213  v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, work, &lwork, rwork,
214  &lrwork, iwork, &info );
215  if( info < 0 ) {
216  info = info - 1;
217  }
218  /* Transpose output matrices */
219  LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
220  ldx11 );
221  LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
222  x12, ldx12 );
223  LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
224  ldx21 );
225  LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
226  x22, ldx22 );
227  if( LAPACKE_lsame( jobu1, 'y' ) ) {
228  LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
229  ldu1 );
230  }
231  if( LAPACKE_lsame( jobu2, 'y' ) ) {
232  LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
233  u2, ldu2 );
234  }
235  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
236  LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
237  v1t, ldv1t );
238  }
239  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
240  LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
241  v2t, ldv2t );
242  }
243  /* Release memory and exit */
244  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
245  LAPACKE_free( v2t_t );
246  }
247 exit_level_7:
248  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
249  LAPACKE_free( v1t_t );
250  }
251 exit_level_6:
252  if( LAPACKE_lsame( jobu2, 'y' ) ) {
253  LAPACKE_free( u2_t );
254  }
255 exit_level_5:
256  if( LAPACKE_lsame( jobu1, 'y' ) ) {
257  LAPACKE_free( u1_t );
258  }
259 exit_level_4:
260  LAPACKE_free( x22_t );
261 exit_level_3:
262  LAPACKE_free( x21_t );
263 exit_level_2:
264  LAPACKE_free( x12_t );
265 exit_level_1:
266  LAPACKE_free( x11_t );
267 exit_level_0:
268  if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
269  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
270  }
271  } else {
272  info = -1;
273  LAPACKE_xerbla( "LAPACKE_cuncsd_work", info );
274  }
275  return info;
276 }
void LAPACK_cuncsd(char *jobu1, char *jobu2, char *jobv1t, char *jobv2t, char *trans, char *signs, lapack_int *m, lapack_int *p, lapack_int *q, lapack_complex_float *x11, lapack_int *ldx11, lapack_complex_float *x12, lapack_int *ldx12, lapack_complex_float *x21, lapack_int *ldx21, lapack_complex_float *x22, lapack_int *ldx22, float *theta, lapack_complex_float *u1, lapack_int *ldu1, lapack_complex_float *u2, lapack_int *ldu2, lapack_complex_float *v1t, lapack_int *ldv1t, lapack_complex_float *v2t, lapack_int *ldv2t, lapack_complex_float *work, lapack_int *lwork, float *rwork, lapack_int *lrwork, lapack_int *iwork, lapack_int *info)
void LAPACKE_cge_trans(int matrix_layout, lapack_int m, lapack_int n, const lapack_complex_float *in, lapack_int ldin, lapack_complex_float *out, lapack_int ldout)
#define LAPACK_ROW_MAJOR
Definition: lapacke.h:119
lapack_int LAPACKE_cuncsd_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_float *x11, lapack_int ldx11, lapack_complex_float *x12, lapack_int ldx12, lapack_complex_float *x21, lapack_int ldx21, lapack_complex_float *x22, lapack_int ldx22, float *theta, lapack_complex_float *u1, lapack_int ldu1, lapack_complex_float *u2, lapack_int ldu2, lapack_complex_float *v1t, lapack_int ldv1t, lapack_complex_float *v2t, lapack_int ldv2t, lapack_complex_float *work, lapack_int lwork, float *rwork, lapack_int lrwork, lapack_int *iwork)
#define lapack_complex_float
Definition: lapacke.h:74
#define MAX(x, y)
Definition: lapacke_utils.h:47
#define LAPACKE_free(p)
Definition: lapacke.h:113
#define LAPACKE_malloc(size)
Definition: lapacke.h:110
lapack_logical LAPACKE_lsame(char ca, char cb)
Definition: lapacke_lsame.c:36
#define LAPACK_COL_MAJOR
Definition: lapacke.h:120
void LAPACKE_xerbla(const char *name, lapack_int info)
#define lapack_int
Definition: lapacke.h:47
#define LAPACK_TRANSPOSE_MEMORY_ERROR
Definition: lapacke.h:123