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