lapack_int LAPACKE_cbdsqr( int matrix_order, char uplo, lapack_int n,
lapack_int ncvt, lapack_int nru, lapack_int ncc,
float* d, float* e, lapack_complex_float* vt,
lapack_int ldvt, lapack_complex_float* u,
lapack_int ldu, lapack_complex_float* c,
lapack_int ldc )
{
lapack_int info = 0;
float* work = NULL;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cbdsqr", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( ncc != 0 ) {
if( LAPACKE_cge_nancheck( matrix_order, n, ncc, c, ldc ) ) {
return -13;
}
}
if( LAPACKE_s_nancheck( n, d, 1 ) ) {
return -7;
}
if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
return -8;
}
if( nru != 0 ) {
if( LAPACKE_cge_nancheck( matrix_order, nru, n, u, ldu ) ) {
return -11;
}
}
if( ncvt != 0 ) {
if( LAPACKE_cge_nancheck( matrix_order, n, ncvt, vt, ldvt ) ) {
return -9;
}
}
#endif
/* Allocate memory for working array(s) */
work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,4*n) );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Call middle-level interface */
info = LAPACKE_cbdsqr_work( matrix_order, uplo, n, ncvt, nru, ncc, d, e, vt,
ldvt, u, ldu, c, ldc, work );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cbdsqr", info );
}
return info;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int ncvt, ncvt_i;
lapack_int nru, nru_i;
lapack_int ncc, ncc_i;
lapack_int ldvt, ldvt_i;
lapack_int ldvt_r;
lapack_int ldu, ldu_i;
lapack_int ldu_r;
lapack_int ldc, ldc_i;
lapack_int ldc_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *d = NULL, *d_i = NULL;
float *e = NULL, *e_i = NULL;
lapack_complex_float *vt = NULL, *vt_i = NULL;
lapack_complex_float *u = NULL, *u_i = NULL;
lapack_complex_float *c = NULL, *c_i = NULL;
float *work = NULL, *work_i = NULL;
float *d_save = NULL;
float *e_save = NULL;
lapack_complex_float *vt_save = NULL;
lapack_complex_float *u_save = NULL;
lapack_complex_float *c_save = NULL;
lapack_complex_float *vt_r = NULL;
lapack_complex_float *u_r = NULL;
lapack_complex_float *c_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_cbdsqr( &uplo, &n, &ncvt, &nru, &ncc, &ldvt, &ldu, &ldc );
ldvt_r = ncvt+2;
ldu_r = n+2;
ldc_r = ncc+2;
uplo_i = uplo;
n_i = n;
ncvt_i = ncvt;
nru_i = nru;
ncc_i = ncc;
ldvt_i = ldvt;
ldu_i = ldu;
ldc_i = ldc;
/* Allocate memory for the LAPACK routine arrays */
d = (float *)LAPACKE_malloc( n * sizeof(float) );
e = (float *)LAPACKE_malloc( n * sizeof(float) );
vt = (lapack_complex_float *)
LAPACKE_malloc( ldvt*ncvt * sizeof(lapack_complex_float) );
u = (lapack_complex_float *)
LAPACKE_malloc( ldu*n * sizeof(lapack_complex_float) );
c = (lapack_complex_float *)
LAPACKE_malloc( ldc*ncc * sizeof(lapack_complex_float) );
work = (float *)LAPACKE_malloc( 4*n * sizeof(float) );
/* Allocate memory for the C interface function arrays */
d_i = (float *)LAPACKE_malloc( n * sizeof(float) );
e_i = (float *)LAPACKE_malloc( n * sizeof(float) );
vt_i = (lapack_complex_float *)
LAPACKE_malloc( ldvt*ncvt * sizeof(lapack_complex_float) );
u_i = (lapack_complex_float *)
LAPACKE_malloc( ldu*n * sizeof(lapack_complex_float) );
c_i = (lapack_complex_float *)
LAPACKE_malloc( ldc*ncc * sizeof(lapack_complex_float) );
work_i = (float *)LAPACKE_malloc( 4*n * sizeof(float) );
/* Allocate memory for the backup arrays */
d_save = (float *)LAPACKE_malloc( n * sizeof(float) );
e_save = (float *)LAPACKE_malloc( n * sizeof(float) );
vt_save = (lapack_complex_float *)
LAPACKE_malloc( ldvt*ncvt * sizeof(lapack_complex_float) );
u_save = (lapack_complex_float *)
LAPACKE_malloc( ldu*n * sizeof(lapack_complex_float) );
c_save = (lapack_complex_float *)
LAPACKE_malloc( ldc*ncc * sizeof(lapack_complex_float) );
/* Allocate memory for the row-major arrays */
vt_r = (lapack_complex_float *)
LAPACKE_malloc( n*(ncvt+2) * sizeof(lapack_complex_float) );
u_r = (lapack_complex_float *)
LAPACKE_malloc( nru*(n+2) * sizeof(lapack_complex_float) );
c_r = (lapack_complex_float *)
LAPACKE_malloc( n*(ncc+2) * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_d( n, d );
init_e( n, e );
init_vt( ldvt*ncvt, vt );
init_u( ldu*n, u );
init_c( ldc*ncc, c );
init_work( 4*n, work );
/* Backup the ouptut arrays */
for( i = 0; i < n; i++ ) {
d_save[i] = d[i];
}
for( i = 0; i < n; i++ ) {
e_save[i] = e[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_save[i] = vt[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_save[i] = u[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_save[i] = c[i];
}
/* Call the LAPACK routine */
cbdsqr_( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt, &ldvt, u, &ldu, c, &ldc,
work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < n; i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_i[i] = vt_save[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_i[i] = u_save[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cbdsqr_work( LAPACK_COL_MAJOR, uplo_i, n_i, ncvt_i, nru_i,
ncc_i, d_i, e_i, vt_i, ldvt_i, u_i, ldu_i,
c_i, ldc_i, work_i );
failed = compare_cbdsqr( d, d_i, e, e_i, vt, vt_i, u, u_i, c, c_i, info,
info_i, ldc, ldu, ldvt, n, ncc, ncvt, nru );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to cbdsqr\n" );
} else {
printf( "FAILED: column-major middle-level interface to cbdsqr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < n; i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_i[i] = vt_save[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_i[i] = u_save[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cbdsqr( LAPACK_COL_MAJOR, uplo_i, n_i, ncvt_i, nru_i,
ncc_i, d_i, e_i, vt_i, ldvt_i, u_i, ldu_i, c_i,
ldc_i );
failed = compare_cbdsqr( d, d_i, e, e_i, vt, vt_i, u, u_i, c, c_i, info,
info_i, ldc, ldu, ldvt, n, ncc, ncvt, nru );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to cbdsqr\n" );
} else {
printf( "FAILED: column-major high-level interface to cbdsqr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < n; i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_i[i] = vt_save[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_i[i] = u_save[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
if( ncvt != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_i, ldvt, vt_r,
ncvt+2 );
}
if( nru != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nru, n, u_i, ldu, u_r, n+2 );
}
if( ncc != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncc, c_i, ldc, c_r, ncc+2 );
}
info_i = LAPACKE_cbdsqr_work( LAPACK_ROW_MAJOR, uplo_i, n_i, ncvt_i, nru_i,
ncc_i, d_i, e_i, vt_r, ldvt_r, u_r, ldu_r,
c_r, ldc_r, work_i );
if( ncvt != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, ncvt, vt_r, ncvt+2, vt_i,
ldvt );
}
if( nru != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nru, n, u_r, n+2, u_i, ldu );
}
if( ncc != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, ncc, c_r, ncc+2, c_i, ldc );
}
failed = compare_cbdsqr( d, d_i, e, e_i, vt, vt_i, u, u_i, c, c_i, info,
info_i, ldc, ldu, ldvt, n, ncc, ncvt, nru );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to cbdsqr\n" );
} else {
printf( "FAILED: row-major middle-level interface to cbdsqr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < n; i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_i[i] = vt_save[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_i[i] = u_save[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
if( ncvt != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_i, ldvt, vt_r,
ncvt+2 );
}
if( nru != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nru, n, u_i, ldu, u_r, n+2 );
}
if( ncc != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncc, c_i, ldc, c_r, ncc+2 );
}
info_i = LAPACKE_cbdsqr( LAPACK_ROW_MAJOR, uplo_i, n_i, ncvt_i, nru_i,
ncc_i, d_i, e_i, vt_r, ldvt_r, u_r, ldu_r, c_r,
ldc_r );
if( ncvt != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, ncvt, vt_r, ncvt+2, vt_i,
ldvt );
}
if( nru != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nru, n, u_r, n+2, u_i, ldu );
}
if( ncc != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, ncc, c_r, ncc+2, c_i, ldc );
}
failed = compare_cbdsqr( d, d_i, e, e_i, vt, vt_i, u, u_i, c, c_i, info,
info_i, ldc, ldu, ldvt, n, ncc, ncvt, nru );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to cbdsqr\n" );
} else {
printf( "FAILED: row-major high-level interface to cbdsqr\n" );
}
/* Release memory */
if( d != NULL ) {
LAPACKE_free( d );
}
if( d_i != NULL ) {
LAPACKE_free( d_i );
}
if( d_save != NULL ) {
LAPACKE_free( d_save );
}
if( e != NULL ) {
LAPACKE_free( e );
}
if( e_i != NULL ) {
LAPACKE_free( e_i );
}
if( e_save != NULL ) {
LAPACKE_free( e_save );
}
if( vt != NULL ) {
LAPACKE_free( vt );
}
if( vt_i != NULL ) {
LAPACKE_free( vt_i );
}
if( vt_r != NULL ) {
LAPACKE_free( vt_r );
}
if( vt_save != NULL ) {
LAPACKE_free( vt_save );
}
if( u != NULL ) {
LAPACKE_free( u );
}
if( u_i != NULL ) {
LAPACKE_free( u_i );
}
if( u_r != NULL ) {
LAPACKE_free( u_r );
}
if( u_save != NULL ) {
LAPACKE_free( u_save );
}
if( c != NULL ) {
LAPACKE_free( c );
}
if( c_i != NULL ) {
LAPACKE_free( c_i );
}
if( c_r != NULL ) {
LAPACKE_free( c_r );
}
if( c_save != NULL ) {
LAPACKE_free( c_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
