LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
lapacke_sorcsd2by1_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 sorcsd2by1
30* Author: Intel Corporation
31*****************************************************************************/
32
33#include "lapacke_utils.h"
34
35lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2,
36 char jobv1t, lapack_int m, lapack_int p,
37 lapack_int q, float* x11, lapack_int ldx11,
38 float* x21, lapack_int ldx21,
39 float* theta, float* u1, lapack_int ldu1,
40 float* u2, lapack_int ldu2, float* v1t,
41 lapack_int ldv1t, float* work, lapack_int lwork,
42 lapack_int* iwork )
43{
44 lapack_int info = 0;
45 if( matrix_layout == LAPACK_COL_MAJOR ) {
46 /* Call LAPACK function and adjust info */
47 LAPACK_sorcsd2by1( &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 float* x11_t = NULL;
66 float* x21_t = NULL;
67 float* u1_t = NULL;
68 float* u2_t = NULL;
69 float* v1t_t = NULL;
70 /* Check leading dimension(s) */
71 if( ldu1 < p ) {
72 info = -21;
73 LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info );
74 return info;
75 }
76 if( ldu2 < m-p ) {
77 info = -23;
78 LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info );
79 return info;
80 }
81 if( ldv1t < q ) {
82 info = -25;
83 LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info );
84 return info;
85 }
86 if( ldx11 < q ) {
87 info = -12;
88 LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info );
89 return info;
90 }
91 if( ldx21 < q ) {
92 info = -16;
93 LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info );
94 return info;
95 }
96 /* Query optimal working array(s) size if requested */
97 if( lwork == -1 ) {
98 LAPACK_sorcsd2by1( &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 = (float*)LAPACKE_malloc( sizeof(float) * ldx11_t * MAX(1,q) );
106 if( x11_t == NULL ) {
108 goto exit_level_0;
109 }
110 x21_t = (float*)LAPACKE_malloc( sizeof(float) * ldx21_t * MAX(1,q) );
111 if( x21_t == NULL ) {
113 goto exit_level_1;
114 }
115 if( LAPACKE_lsame( jobu1, 'y' ) ) {
116 u1_t = (float*)
117 LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) );
118 if( u1_t == NULL ) {
120 goto exit_level_2;
121 }
122 }
123 if( LAPACKE_lsame( jobu2, 'y' ) ) {
124 u2_t = (float*)
125 LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) );
126 if( u2_t == NULL ) {
128 goto exit_level_3;
129 }
130 }
131 if( LAPACKE_lsame( jobv1t, 'y' ) ) {
132 v1t_t = (float*)
133 LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) );
134 if( v1t_t == NULL ) {
136 goto exit_level_4;
137 }
138 }
139 /* Transpose input matrices */
140 LAPACKE_sge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
141 ldx11_t );
142 LAPACKE_sge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
143 ldx21_t );
144 /* Call LAPACK function and adjust info */
145 LAPACK_sorcsd2by1( &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_sge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
154 ldx11 );
155 LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
156 ldx21 );
157 if( LAPACKE_lsame( jobu1, 'y' ) ) {
158 LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
159 ldu1 );
160 }
161 if( LAPACKE_lsame( jobu2, 'y' ) ) {
162 LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
163 u2, ldu2 );
164 }
165 if( LAPACKE_lsame( jobv1t, 'y' ) ) {
166 LAPACKE_sge_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 }
173exit_level_4:
174 if( LAPACKE_lsame( jobu2, 'y' ) ) {
175 LAPACKE_free( u2_t );
176 }
177exit_level_3:
178 if( LAPACKE_lsame( jobu1, 'y' ) ) {
179 LAPACKE_free( u1_t );
180 }
181exit_level_2:
182 LAPACKE_free( x21_t );
183exit_level_1:
184 LAPACKE_free( x11_t );
185exit_level_0:
186 if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
187 LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info );
188 }
189 } else {
190 info = -1;
191 LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info );
192 }
193 return info;
194}
#define LAPACK_sorcsd2by1(...)
Definition: lapack.h:11341
#define lapack_int
Definition: lapack.h:87
#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_int LAPACKE_sorcsd2by1_work(int matrix_layout, char jobu1, char jobu2, char jobv1t, lapack_int m, lapack_int p, lapack_int q, float *x11, lapack_int ldx11, float *x21, lapack_int ldx21, float *theta, float *u1, lapack_int ldu1, float *u2, lapack_int ldu2, float *v1t, lapack_int ldv1t, float *work, lapack_int lwork, lapack_int *iwork)
lapack_logical LAPACKE_lsame(char ca, char cb)
Definition: lapacke_lsame.c:35
void LAPACKE_xerbla(const char *name, lapack_int info)
void LAPACKE_sge_trans(int matrix_layout, lapack_int m, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout)
#define MAX(x, y)
Definition: lapacke_utils.h:46