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 zunbdb
30 * Author: Intel Corporation
31 * Generated November 2015
32 *****************************************************************************/
33 
34 #include "lapacke_utils.h"
35 
LAPACKE_zunbdb_work(int matrix_layout,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,double * phi,lapack_complex_double * taup1,lapack_complex_double * taup2,lapack_complex_double * tauq1,lapack_complex_double * tauq2,lapack_complex_double * work,lapack_int lwork)36 lapack_int LAPACKE_zunbdb_work( int matrix_layout, char trans, char signs,
37                                 lapack_int m, lapack_int p, lapack_int q,
38                                 lapack_complex_double* x11, lapack_int ldx11,
39                                 lapack_complex_double* x12, lapack_int ldx12,
40                                 lapack_complex_double* x21, lapack_int ldx21,
41                                 lapack_complex_double* x22, lapack_int ldx22,
42                                 double* theta, double* phi,
43                                 lapack_complex_double* taup1,
44                                 lapack_complex_double* taup2,
45                                 lapack_complex_double* tauq1,
46                                 lapack_complex_double* tauq2,
47                                 lapack_complex_double* work, lapack_int lwork )
48 {
49     lapack_int info = 0;
50     if( matrix_layout == LAPACK_COL_MAJOR ) {
51         /* Call LAPACK function and adjust info */
52         LAPACK_zunbdb( &trans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12,
53                        x21, &ldx21, x22, &ldx22, theta, phi, taup1, taup2,
54                        tauq1, tauq2, work, &lwork, &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 ldx11_t = MAX(1,nrows_x11);
64         lapack_int ldx12_t = MAX(1,nrows_x12);
65         lapack_int ldx21_t = MAX(1,nrows_x21);
66         lapack_int ldx22_t = MAX(1,nrows_x22);
67         lapack_complex_double* x11_t = NULL;
68         lapack_complex_double* x12_t = NULL;
69         lapack_complex_double* x21_t = NULL;
70         lapack_complex_double* x22_t = NULL;
71         /* Check leading dimension(s) */
72         if( ldx11 < q ) {
73             info = -8;
74             LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
75             return info;
76         }
77         if( ldx12 < m-q ) {
78             info = -10;
79             LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
80             return info;
81         }
82         if( ldx21 < q ) {
83             info = -12;
84             LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
85             return info;
86         }
87         if( ldx22 < m-q ) {
88             info = -14;
89             LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
90             return info;
91         }
92         /* Query optimal working array(s) size if requested */
93         if( lwork == -1 ) {
94             LAPACK_zunbdb( &trans, &signs, &m, &p, &q, x11, &ldx11_t, x12,
95                            &ldx12_t, x21, &ldx21_t, x22, &ldx22_t, theta, phi,
96                            taup1, taup2, tauq1, tauq2, work, &lwork, &info );
97             return (info < 0) ? (info - 1) : info;
98         }
99         /* Allocate memory for temporary array(s) */
100         x11_t = (lapack_complex_double*)
101             LAPACKE_malloc( sizeof(lapack_complex_double) *
102                             ldx11_t * MAX(1,q) );
103         if( x11_t == NULL ) {
104             info = LAPACK_TRANSPOSE_MEMORY_ERROR;
105             goto exit_level_0;
106         }
107         x12_t = (lapack_complex_double*)
108             LAPACKE_malloc( sizeof(lapack_complex_double) *
109                             ldx12_t * MAX(1,m-q) );
110         if( x12_t == NULL ) {
111             info = LAPACK_TRANSPOSE_MEMORY_ERROR;
112             goto exit_level_1;
113         }
114         x21_t = (lapack_complex_double*)
115             LAPACKE_malloc( sizeof(lapack_complex_double) *
116                             ldx21_t * MAX(1,q) );
117         if( x21_t == NULL ) {
118             info = LAPACK_TRANSPOSE_MEMORY_ERROR;
119             goto exit_level_2;
120         }
121         x22_t = (lapack_complex_double*)
122             LAPACKE_malloc( sizeof(lapack_complex_double) *
123                             ldx22_t * MAX(1,m-q) );
124         if( x22_t == NULL ) {
125             info = LAPACK_TRANSPOSE_MEMORY_ERROR;
126             goto exit_level_3;
127         }
128         /* Transpose input matrices */
129         LAPACKE_zge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t,
130                            ldx11_t );
131         LAPACKE_zge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t,
132                            ldx12_t );
133         LAPACKE_zge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t,
134                            ldx21_t );
135         LAPACKE_zge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t,
136                            ldx22_t );
137         /* Call LAPACK function and adjust info */
138         LAPACK_zunbdb( &trans, &signs, &m, &p, &q, x11_t, &ldx11_t, x12_t,
139                        &ldx12_t, x21_t, &ldx21_t, x22_t, &ldx22_t, theta, phi,
140                        taup1, taup2, tauq1, tauq2, work, &lwork, &info );
141         if( info < 0 ) {
142             info = info - 1;
143         }
144         /* Transpose output matrices */
145         LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11,
146                            ldx11 );
147         LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t,
148                            x12, ldx12 );
149         LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21,
150                            ldx21 );
151         LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t,
152                            x22, ldx22 );
153         /* Release memory and exit */
154         LAPACKE_free( x22_t );
155 exit_level_3:
156         LAPACKE_free( x21_t );
157 exit_level_2:
158         LAPACKE_free( x12_t );
159 exit_level_1:
160         LAPACKE_free( x11_t );
161 exit_level_0:
162         if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
163             LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
164         }
165     } else {
166         info = -1;
167         LAPACKE_xerbla( "LAPACKE_zunbdb_work", info );
168     }
169     return info;
170 }
171