LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
lapacke_sorcsd_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 sorcsd
30 * Author: Intel Corporation
31 * Generated November 2015
32 *****************************************************************************/
33 
34 #include "lapacke_utils.h"
35 
36 lapack_int LAPACKE_sorcsd_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, float* x11, lapack_int ldx11,
40  float* x12, lapack_int ldx12, float* x21,
41  lapack_int ldx21, float* x22, lapack_int ldx22,
42  float* theta, float* u1, lapack_int ldu1,
43  float* u2, lapack_int ldu2, float* v1t,
44  lapack_int ldv1t, float* v2t, lapack_int ldv2t,
45  float* work, lapack_int lwork,
46  lapack_int* iwork )
47 {
48  lapack_int info = 0;
49  if( matrix_layout == LAPACK_COL_MAJOR ) {
50  /* Call LAPACK function and adjust info */
51  LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
52  &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22, &ldx22,
53  theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t, &ldv2t,
54  work, &lwork, iwork, &info );
55  if( info < 0 ) {
56  info = info - 1;
57  }
58  } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
59  lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
60  lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
61  lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
62  lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
63  lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
64  lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
65  lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
66  lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
67  lapack_int ldu1_t = MAX(1,nrows_u1);
68  lapack_int ldu2_t = MAX(1,nrows_u2);
69  lapack_int ldv1t_t = MAX(1,nrows_v1t);
70  lapack_int ldv2t_t = MAX(1,nrows_v2t);
71  lapack_int ldx11_t = MAX(1,nrows_x11);
72  lapack_int ldx12_t = MAX(1,nrows_x12);
73  lapack_int ldx21_t = MAX(1,nrows_x21);
74  lapack_int ldx22_t = MAX(1,nrows_x22);
75  float* x11_t = NULL;
76  float* x12_t = NULL;
77  float* x21_t = NULL;
78  float* x22_t = NULL;
79  float* u1_t = NULL;
80  float* u2_t = NULL;
81  float* v1t_t = NULL;
82  float* v2t_t = NULL;
83  /* Check leading dimension(s) */
84  if( ldu1 < p ) {
85  info = -21;
86  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
87  return info;
88  }
89  if( ldu2 < m-p ) {
90  info = -23;
91  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
92  return info;
93  }
94  if( ldv1t < q ) {
95  info = -25;
96  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
97  return info;
98  }
99  if( ldv2t < m-q ) {
100  info = -27;
101  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
102  return info;
103  }
104  if( ldx11 < q ) {
105  info = -12;
106  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
107  return info;
108  }
109  if( ldx12 < m-q ) {
110  info = -14;
111  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
112  return info;
113  }
114  if( ldx21 < q ) {
115  info = -16;
116  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
117  return info;
118  }
119  if( ldx22 < m-q ) {
120  info = -18;
121  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
122  return info;
123  }
124  /* Query optimal working array(s) size if requested */
125  if( lwork == -1 ) {
126  LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m,
127  &p, &q, x11, &ldx11_t, x12, &ldx12_t, x21, &ldx21_t,
128  x22, &ldx22_t, theta, u1, &ldu1_t, u2, &ldu2_t, v1t,
129  &ldv1t_t, v2t, &ldv2t_t, work, &lwork, iwork,
130  &info );
131  return (info < 0) ? (info - 1) : info;
132  }
133  /* Allocate memory for temporary array(s) */
134  x11_t = (float*)LAPACKE_malloc( sizeof(float) * ldx11_t * MAX(1,q) );
135  if( x11_t == NULL ) {
136  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
137  goto exit_level_0;
138  }
139  x12_t = (float*)LAPACKE_malloc( sizeof(float) * ldx12_t * MAX(1,m-q) );
140  if( x12_t == NULL ) {
141  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
142  goto exit_level_1;
143  }
144  x21_t = (float*)LAPACKE_malloc( sizeof(float) * ldx21_t * MAX(1,q) );
145  if( x21_t == NULL ) {
146  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
147  goto exit_level_2;
148  }
149  x22_t = (float*)LAPACKE_malloc( sizeof(float) * ldx22_t * MAX(1,m-q) );
150  if( x22_t == NULL ) {
151  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
152  goto exit_level_3;
153  }
154  if( LAPACKE_lsame( jobu1, 'y' ) ) {
155  u1_t = (float*)LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) );
156  if( u1_t == NULL ) {
157  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
158  goto exit_level_4;
159  }
160  }
161  if( LAPACKE_lsame( jobu2, 'y' ) ) {
162  u2_t = (float*)
163  LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) );
164  if( u2_t == NULL ) {
165  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
166  goto exit_level_5;
167  }
168  }
169  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
170  v1t_t = (float*)
171  LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) );
172  if( v1t_t == NULL ) {
173  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
174  goto exit_level_6;
175  }
176  }
177  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
178  v2t_t = (float*)
179  LAPACKE_malloc( sizeof(float) * ldv2t_t * MAX(1,m-q) );
180  if( v2t_t == NULL ) {
181  info = LAPACK_TRANSPOSE_MEMORY_ERROR;
182  goto exit_level_7;
183  }
184  }
185  /* Transpose input matrices */
186  LAPACKE_sge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
187  ldx11_t );
188  LAPACKE_sge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
189  ldx12_t );
190  LAPACKE_sge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
191  ldx21_t );
192  LAPACKE_sge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
193  ldx22_t );
194  /* Call LAPACK function and adjust info */
195  LAPACK_sorcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &signs, &m, &p,
196  &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t,
197  x22_t, &ldx22_t, theta, u1_t, &ldu1_t, u2_t, &ldu2_t,
198  v1t_t, &ldv1t_t, v2t_t, &ldv2t_t, work, &lwork, iwork,
199  &info );
200  if( info < 0 ) {
201  info = info - 1;
202  }
203  /* Transpose output matrices */
204  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
205  ldx11 );
206  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
207  x12, ldx12 );
208  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
209  ldx21 );
210  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
211  x22, ldx22 );
212  if( LAPACKE_lsame( jobu1, 'y' ) ) {
213  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
214  ldu1 );
215  }
216  if( LAPACKE_lsame( jobu2, 'y' ) ) {
217  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
218  u2, ldu2 );
219  }
220  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
221  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
222  v1t, ldv1t );
223  }
224  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
225  LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
226  v2t, ldv2t );
227  }
228  /* Release memory and exit */
229  if( LAPACKE_lsame( jobv2t, 'y' ) ) {
230  LAPACKE_free( v2t_t );
231  }
232 exit_level_7:
233  if( LAPACKE_lsame( jobv1t, 'y' ) ) {
234  LAPACKE_free( v1t_t );
235  }
236 exit_level_6:
237  if( LAPACKE_lsame( jobu2, 'y' ) ) {
238  LAPACKE_free( u2_t );
239  }
240 exit_level_5:
241  if( LAPACKE_lsame( jobu1, 'y' ) ) {
242  LAPACKE_free( u1_t );
243  }
244 exit_level_4:
245  LAPACKE_free( x22_t );
246 exit_level_3:
247  LAPACKE_free( x21_t );
248 exit_level_2:
249  LAPACKE_free( x12_t );
250 exit_level_1:
251  LAPACKE_free( x11_t );
252 exit_level_0:
253  if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
254  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
255  }
256  } else {
257  info = -1;
258  LAPACKE_xerbla( "LAPACKE_sorcsd_work", info );
259  }
260  return info;
261 }
LAPACK_ROW_MAJOR
#define LAPACK_ROW_MAJOR
Definition: lapacke.h:119
LAPACKE_sorcsd_work
lapack_int LAPACKE_sorcsd_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, float *x11, lapack_int ldx11, float *x12, lapack_int ldx12, float *x21, lapack_int ldx21, float *x22, lapack_int ldx22, float *theta, float *u1, lapack_int ldu1, float *u2, lapack_int ldu2, float *v1t, lapack_int ldv1t, float *v2t, lapack_int ldv2t, float *work, lapack_int lwork, lapack_int *iwork)
Definition: lapacke_sorcsd_work.c:36
lapacke_utils.h
LAPACKE_sge_trans
void LAPACKE_sge_trans(int matrix_layout, lapack_int m, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout)
Definition: lapacke_sge_trans.c:40
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
LAPACK_sorcsd
void LAPACK_sorcsd(char *jobu1, char *jobu2, char *jobv1t, char *jobv2t, char *trans, char *signs, lapack_int *m, lapack_int *p, lapack_int *q, float *x11, lapack_int *ldx11, float *x12, lapack_int *ldx12, float *x21, lapack_int *ldx21, float *x22, lapack_int *ldx22, float *theta, float *u1, lapack_int *ldu1, float *u2, lapack_int *ldu2, float *v1t, lapack_int *ldv1t, float *v2t, lapack_int *ldv2t, float *work, lapack_int *lwork, lapack_int *iwork, lapack_int *info)