lapack_int LAPACKE_cpteqr( int matrix_order, char compz, lapack_int n, float* d,
float* e, lapack_complex_float* z, lapack_int ldz )
{
lapack_int info = 0;
/* Additional scalars declarations for work arrays */
lapack_int lwork;
float* work = NULL;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cpteqr", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_s_nancheck( n, d, 1 ) ) {
return -4;
}
if( LAPACKE_s_nancheck( n-1, e, 1 ) ) {
return -5;
}
if( LAPACKE_lsame( compz, 'v' ) ) {
if( LAPACKE_cge_nancheck( matrix_order, n, n, z, ldz ) ) {
return -6;
}
}
#endif
/* Additional scalars initializations for work arrays */
if( LAPACKE_lsame( compz, 'n' ) ) {
lwork = 1;
} else {
lwork = MAX(1,4*n-4);
}
/* Allocate memory for working array(s) */
work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Call middle-level interface */
info = LAPACKE_cpteqr_work( matrix_order, compz, n, d, e, z, ldz, work );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cpteqr", info );
}
return info;
}
int main(void)
{
/* Local scalars */
char compz, compz_i;
lapack_int n, n_i;
lapack_int ldz, ldz_i;
lapack_int ldz_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 *z = NULL, *z_i = NULL;
float *work = NULL, *work_i = NULL;
float *d_save = NULL;
float *e_save = NULL;
lapack_complex_float *z_save = NULL;
lapack_complex_float *z_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_cpteqr( &compz, &n, &ldz );
ldz_r = n+2;
compz_i = compz;
n_i = n;
ldz_i = ldz;
/* Allocate memory for the LAPACK routine arrays */
d = (float *)LAPACKE_malloc( n * sizeof(float) );
e = (float *)LAPACKE_malloc( (n-1) * sizeof(float) );
z = (lapack_complex_float *)
LAPACKE_malloc( ldz*n * 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-1) * sizeof(float) );
z_i = (lapack_complex_float *)
LAPACKE_malloc( ldz*n * 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-1) * sizeof(float) );
z_save = (lapack_complex_float *)
LAPACKE_malloc( ldz*n * sizeof(lapack_complex_float) );
/* Allocate memory for the row-major arrays */
z_r = (lapack_complex_float *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_d( n, d );
init_e( (n-1), e );
init_z( ldz*n, z );
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-1); i++ ) {
e_save[i] = e[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_save[i] = z[i];
}
/* Call the LAPACK routine */
cpteqr_( &compz, &n, d, e, z, &ldz, 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-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cpteqr_work( LAPACK_COL_MAJOR, compz_i, n_i, d_i, e_i, z_i,
ldz_i, work_i );
failed = compare_cpteqr( d, d_i, e, e_i, z, z_i, info, info_i, ldz, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to cpteqr\n" );
} else {
printf( "FAILED: column-major middle-level interface to cpteqr\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-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cpteqr( LAPACK_COL_MAJOR, compz_i, n_i, d_i, e_i, z_i,
ldz_i );
failed = compare_cpteqr( d, d_i, e, e_i, z, z_i, info, info_i, ldz, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to cpteqr\n" );
} else {
printf( "FAILED: column-major high-level interface to cpteqr\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-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 );
info_i = LAPACKE_cpteqr_work( LAPACK_ROW_MAJOR, compz_i, n_i, d_i, e_i, z_r,
ldz_r, work_i );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz );
failed = compare_cpteqr( d, d_i, e, e_i, z, z_i, info, info_i, ldz, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to cpteqr\n" );
} else {
printf( "FAILED: row-major middle-level interface to cpteqr\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-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 );
info_i = LAPACKE_cpteqr( LAPACK_ROW_MAJOR, compz_i, n_i, d_i, e_i, z_r,
ldz_r );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz );
failed = compare_cpteqr( d, d_i, e, e_i, z, z_i, info, info_i, ldz, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to cpteqr\n" );
} else {
printf( "FAILED: row-major high-level interface to cpteqr\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( z != NULL ) {
LAPACKE_free( z );
}
if( z_i != NULL ) {
LAPACKE_free( z_i );
}
if( z_r != NULL ) {
LAPACKE_free( z_r );
}
if( z_save != NULL ) {
LAPACKE_free( z_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}