Skip to content

Commit d8574a9

Browse files
julielangoujulielangou
authored
Merge pull request #120 from echeresh/lapacke_bdb_csd
lapacke_*(bb|or|un)(csd|bdb): forward calls to LAPACK without conversion
2 parents 48a80fb + 65d313c commit d8574a9

24 files changed

+404
-1926
lines changed

‎LAPACKE/src/lapacke_cbbcsd.c‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -47,40 +47,41 @@ lapack_int LAPACKE_cbbcsd( int matrix_layout, char jobu1, char jobu2,
4747
lapack_int lrwork = -1;
4848
float* rwork = NULL;
4949
float rwork_query;
50-
lapack_int nrows_u1, nrows_u2, nrows_v1t, nrows_v2t;
50+
int lapack_layout;
5151
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
5252
LAPACKE_xerbla( "LAPACKE_cbbcsd", -1 );
5353
return -1;
5454
}
55+
if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
56+
lapack_layout = LAPACK_COL_MAJOR;
57+
} else {
58+
lapack_layout = LAPACK_ROW_MAJOR;
59+
}
5560
#ifndef LAPACK_DISABLE_NAN_CHECK
5661
/* Optionally check input matrices for NaNs */
57-
nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
58-
nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
59-
nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
60-
nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
6162
if( LAPACKE_s_nancheck( q-1, phi, 1 ) ) {
6263
return -11;
6364
}
6465
if( LAPACKE_s_nancheck( q, theta, 1 ) ) {
6566
return -10;
6667
}
6768
if( LAPACKE_lsame( jobu1, 'y' ) ) {
68-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_u1, p, u1, ldu1 ) ) {
69+
if( LAPACKE_cge_nancheck( lapack_layout, p, p, u1, ldu1 ) ) {
6970
return -12;
7071
}
7172
}
7273
if( LAPACKE_lsame( jobu2, 'y' ) ) {
73-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_u2, m-p, u2, ldu2 ) ) {
74+
if( LAPACKE_cge_nancheck( lapack_layout, m-p, m-p, u2, ldu2 ) ) {
7475
return -14;
7576
}
7677
}
7778
if( LAPACKE_lsame( jobv1t, 'y' ) ) {
78-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v1t, q, v1t, ldv1t ) ) {
79+
if( LAPACKE_cge_nancheck( lapack_layout, q, q, v1t, ldv1t ) ) {
7980
return -16;
8081
}
8182
}
8283
if( LAPACKE_lsame( jobv2t, 'y' ) ) {
83-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v2t, m-q, v2t, ldv2t ) ) {
84+
if( LAPACKE_cge_nancheck( lapack_layout, m-q, m-q, v2t, ldv2t ) ) {
8485
return -18;
8586
}
8687
}

‎LAPACKE/src/lapacke_cbbcsd_work.c‎

Lines changed: 23 additions & 143 deletions
Original file line numberDiff line numberDiff line change
@@ -47,156 +47,36 @@ lapack_int LAPACKE_cbbcsd_work( int matrix_layout, char jobu1, char jobu2,
4747
lapack_int lrwork )
4848
{
4949
lapack_int info = 0;
50-
if( matrix_layout == LAPACK_COL_MAJOR ) {
50+
/* LAPACK function works with matrices in both layouts. It is supported
51+
* through TRANS parameter. So all conversion between layouts can be
52+
* completed in LAPACK function. See the table below which describes how
53+
* every LAPACKE call is forwarded to corresponding LAPACK call.
54+
*
55+
* matrix_layout | trans_LAPACKE | -> trans_LAPACK
56+
* | (trans) | (ltrans)
57+
* -----------------+---------------+----------------
58+
* LAPACK_COL_MAJOR | 'N' | -> 'N'
59+
* LAPACK_COL_MAJOR | 'T' | -> 'T'
60+
* LAPACK_ROW_MAJOR | 'N' | -> 'T'
61+
* LAPACK_ROW_MAJOR | 'T' | -> 'T'
62+
* (note that for row major layout trans parameter is ignored)
63+
*/
64+
if( matrix_layout == LAPACK_COL_MAJOR ||
65+
matrix_layout == LAPACK_ROW_MAJOR ) {
66+
char ltrans;
67+
if( !LAPACKE_lsame( trans, 't' ) && matrix_layout == LAPACK_COL_MAJOR ) {
68+
ltrans = 'n';
69+
} else {
70+
ltrans = 't';
71+
}
5172
/* Call LAPACK function and adjust info */
52-
LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
73+
LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &ltrans, &m, &p, &q,
5374
theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
5475
&ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e,
5576
rwork, &lrwork, &info );
5677
if( info < 0 ) {
5778
info = info - 1;
5879
}
59-
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
60-
lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
61-
lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
62-
lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
63-
lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
64-
lapack_int ldu1_t = MAX(1,nrows_u1);
65-
lapack_int ldu2_t = MAX(1,nrows_u2);
66-
lapack_int ldv1t_t = MAX(1,nrows_v1t);
67-
lapack_int ldv2t_t = MAX(1,nrows_v2t);
68-
lapack_complex_float* u1_t = NULL;
69-
lapack_complex_float* u2_t = NULL;
70-
lapack_complex_float* v1t_t = NULL;
71-
lapack_complex_float* v2t_t = NULL;
72-
/* Check leading dimension(s) */
73-
if( ldu1 < p ) {
74-
info = -13;
75-
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
76-
return info;
77-
}
78-
if( ldu2 < m-p ) {
79-
info = -15;
80-
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
81-
return info;
82-
}
83-
if( ldv1t < q ) {
84-
info = -17;
85-
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
86-
return info;
87-
}
88-
if( ldv2t < m-q ) {
89-
info = -19;
90-
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
91-
return info;
92-
}
93-
/* Query optimal working array(s) size if requested */
94-
if( lrwork == -1 ) {
95-
LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
96-
theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
97-
v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e,
98-
b22d, b22e, rwork, &lrwork, &info );
99-
return (info < 0) ? (info - 1) : info;
100-
}
101-
/* Allocate memory for temporary array(s) */
102-
if( LAPACKE_lsame( jobu1, 'y' ) ) {
103-
u1_t = (lapack_complex_float*)
104-
LAPACKE_malloc( sizeof(lapack_complex_float) *
105-
ldu1_t * MAX(1,p) );
106-
if( u1_t == NULL ) {
107-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
108-
goto exit_level_0;
109-
}
110-
}
111-
if( LAPACKE_lsame( jobu2, 'y' ) ) {
112-
u2_t = (lapack_complex_float*)
113-
LAPACKE_malloc( sizeof(lapack_complex_float) *
114-
ldu2_t * MAX(1,m-p) );
115-
if( u2_t == NULL ) {
116-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
117-
goto exit_level_1;
118-
}
119-
}
120-
if( LAPACKE_lsame( jobv1t, 'y' ) ) {
121-
v1t_t = (lapack_complex_float*)
122-
LAPACKE_malloc( sizeof(lapack_complex_float) *
123-
ldv1t_t * MAX(1,q) );
124-
if( v1t_t == NULL ) {
125-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
126-
goto exit_level_2;
127-
}
128-
}
129-
if( LAPACKE_lsame( jobv2t, 'y' ) ) {
130-
v2t_t = (lapack_complex_float*)
131-
LAPACKE_malloc( sizeof(lapack_complex_float) *
132-
ldv2t_t * MAX(1,m-q) );
133-
if( v2t_t == NULL ) {
134-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
135-
goto exit_level_3;
136-
}
137-
}
138-
/* Transpose input matrices */
139-
if( LAPACKE_lsame( jobu1, 'y' ) ) {
140-
LAPACKE_cge_trans( matrix_layout, nrows_u1, p, u1, ldu1, u1_t,
141-
ldu1_t );
142-
}
143-
if( LAPACKE_lsame( jobu2, 'y' ) ) {
144-
LAPACKE_cge_trans( matrix_layout, nrows_u2, m-p, u2, ldu2, u2_t,
145-
ldu2_t );
146-
}
147-
if( LAPACKE_lsame( jobv1t, 'y' ) ) {
148-
LAPACKE_cge_trans( matrix_layout, nrows_v1t, q, v1t, ldv1t, v1t_t,
149-
ldv1t_t );
150-
}
151-
if( LAPACKE_lsame( jobv2t, 'y' ) ) {
152-
LAPACKE_cge_trans( matrix_layout, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
153-
ldv2t_t );
154-
}
155-
/* Call LAPACK function and adjust info */
156-
LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
157-
theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
158-
&ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
159-
b21e, b22d, b22e, rwork, &lrwork, &info );
160-
if( info < 0 ) {
161-
info = info - 1;
162-
}
163-
/* Transpose output matrices */
164-
if( LAPACKE_lsame( jobu1, 'y' ) ) {
165-
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
166-
ldu1 );
167-
}
168-
if( LAPACKE_lsame( jobu2, 'y' ) ) {
169-
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
170-
u2, ldu2 );
171-
}
172-
if( LAPACKE_lsame( jobv1t, 'y' ) ) {
173-
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
174-
v1t, ldv1t );
175-
}
176-
if( LAPACKE_lsame( jobv2t, 'y' ) ) {
177-
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
178-
v2t, ldv2t );
179-
}
180-
/* Release memory and exit */
181-
if( LAPACKE_lsame( jobv2t, 'y' ) ) {
182-
LAPACKE_free( v2t_t );
183-
}
184-
exit_level_3:
185-
if( LAPACKE_lsame( jobv1t, 'y' ) ) {
186-
LAPACKE_free( v1t_t );
187-
}
188-
exit_level_2:
189-
if( LAPACKE_lsame( jobu2, 'y' ) ) {
190-
LAPACKE_free( u2_t );
191-
}
192-
exit_level_1:
193-
if( LAPACKE_lsame( jobu1, 'y' ) ) {
194-
LAPACKE_free( u1_t );
195-
}
196-
exit_level_0:
197-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
198-
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
199-
}
20080
} else {
20181
info = -1;
20282
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );

‎LAPACKE/src/lapacke_cunbdb.c‎

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -49,27 +49,28 @@ lapack_int LAPACKE_cunbdb( int matrix_layout, char trans, char signs,
4949
lapack_int lwork = -1;
5050
lapack_complex_float* work = NULL;
5151
lapack_complex_float work_query;
52-
lapack_int nrows_x11, nrows_x12, nrows_x21, nrows_x22;
52+
int lapack_layout;
5353
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
5454
LAPACKE_xerbla( "LAPACKE_cunbdb", -1 );
5555
return -1;
5656
}
57+
if( LAPACKE_lsame( trans, 'n' ) && matrix_layout == LAPACK_COL_MAJOR ) {
58+
lapack_layout = LAPACK_COL_MAJOR;
59+
} else {
60+
lapack_layout = LAPACK_ROW_MAJOR;
61+
}
5762
#ifndef LAPACK_DISABLE_NAN_CHECK
5863
/* Optionally check input matrices for NaNs */
59-
nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q);
60-
nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q);
61-
nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q);
62-
nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q);
63-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) {
64+
if( LAPACKE_cge_nancheck( lapack_layout, p, q, x11, ldx11 ) ) {
6465
return -7;
6566
}
66-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_x12, m-q, x12, ldx12 ) ) {
67+
if( LAPACKE_cge_nancheck( lapack_layout, p, m-q, x12, ldx12 ) ) {
6768
return -9;
6869
}
69-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) {
70+
if( LAPACKE_cge_nancheck( lapack_layout, m-p, q, x21, ldx21 ) ) {
7071
return -11;
7172
}
72-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_x22, m-q, x22, ldx22 ) ) {
73+
if( LAPACKE_cge_nancheck( lapack_layout, m-p, m-q, x22, ldx22 ) ) {
7374
return -13;
7475
}
7576
#endif

0 commit comments

Comments
 (0)