void BrennerPotential::Initialize()
{
DEBUGPRINT;
// Initialize ktype_to_z and z_to_ktype
ktype_to_z[0] = 0;
ktype_to_z[1] = 6; // Carbon
ktype_to_z[2] = 1; // Hydrogen
ktype_to_z[3] = 14; // Silicon
ktype_to_z[4] = 32; // Germanium
for (int i = 0; i < MAXATNO+1; i++)
z_to_ktype[i] = 0;
for (int i = 0; i < 5; i++)
z_to_ktype[ktype_to_z[i]] = i;
for(int i = 0; i < 4; ++i)
for(int j = 0; j < 4; ++j)
rb2[i][j] = 0; // Looks like otherwise may be uninitialized!
init_c();
init_xh();
init_in2();
init_in3();
// Initialize rmax and RLIST (not used?). Uses rb2 initialized in init_c().
//double rll = RLL;
// RLIST is apparently the square of the neighborlist cutoff. XXX Check!
rmax_nosq = 0;
for(int i = 0; i < 4; ++i)
{
for(int j = 0; j < 4; ++j)
{
Float r2 = rb2[i][j];
//RLIST[i+1][j+1] = (r2+rll)*(r2+rll);
rmax[i][j] = r2*r2;
if (rmax_nosq < r2)
rmax_nosq = r2;
}
}
si_ge_init();
}
int main(void)
{
/* Local scalars */
char side, side_i;
char trans, trans_i;
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int ilo, ilo_i;
lapack_int ihi, ihi_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int ldc, ldc_i;
lapack_int ldc_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
/* Declare scalars */
lapack_int r;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_complex_double *tau = NULL, *tau_i = NULL;
lapack_complex_double *c = NULL, *c_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
lapack_complex_double *c_save = NULL;
lapack_complex_double *a_r = NULL;
lapack_complex_double *c_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zunmhr( &side, &trans, &m, &n, &ilo, &ihi, &lda, &ldc,
&lwork );
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_r = r+2;
ldc_r = n+2;
side_i = side;
trans_i = trans;
m_i = m;
n_i = n;
ilo_i = ilo;
ihi_i = ihi;
lda_i = lda;
ldc_i = ldc;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*m * sizeof(lapack_complex_double) );
tau = (lapack_complex_double *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_double) );
c = (lapack_complex_double *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
work = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*m * sizeof(lapack_complex_double) );
tau_i = (lapack_complex_double *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_double) );
c_i = (lapack_complex_double *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the backup arrays */
c_save = (lapack_complex_double *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( r*(r+2) * sizeof(lapack_complex_double) );
c_r = (lapack_complex_double *)
LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*m, a );
init_tau( (m-1), tau );
init_c( ldc*n, c );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldc*n; i++ ) {
c_save[i] = c[i];
}
/* Call the LAPACK routine */
zunmhr_( &side, &trans, &m, &n, &ilo, &ihi, a, &lda, tau, c, &ldc, work,
&lwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunmhr_work( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i,
ilo_i, ihi_i, a_i, lda_i, tau_i, c_i, ldc_i,
work_i, lwork_i );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zunmhr\n" );
} else {
printf( "FAILED: column-major middle-level interface to zunmhr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunmhr( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i, ilo_i,
ihi_i, a_i, lda_i, tau_i, c_i, ldc_i );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zunmhr\n" );
} else {
printf( "FAILED: column-major high-level interface to zunmhr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, r, a_i, lda, a_r, r+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_zunmhr_work( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i,
ilo_i, ihi_i, a_r, lda_r, tau_i, c_r, ldc_r,
work_i, lwork_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zunmhr\n" );
} else {
printf( "FAILED: row-major middle-level interface to zunmhr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, r, a_i, lda, a_r, r+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_zunmhr( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i, ilo_i,
ihi_i, a_r, lda_r, tau_i, c_r, ldc_r );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zunmhr\n" );
} else {
printf( "FAILED: row-major high-level interface to zunmhr\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
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;
}
int main(void)
{
/* Local scalars */
char side, side_i;
char uplo, uplo_i;
char trans, trans_i;
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int ldc, ldc_i;
lapack_int ldc_r;
lapack_int info, info_i;
/* Declare scalars */
lapack_int lwork;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_float *ap = NULL, *ap_i = NULL;
lapack_complex_float *tau = NULL, *tau_i = NULL;
lapack_complex_float *c = NULL, *c_i = NULL;
lapack_complex_float *work = NULL, *work_i = NULL;
lapack_complex_float *c_save = NULL;
lapack_complex_float *ap_r = NULL;
lapack_complex_float *c_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_cupmtr( &side, &uplo, &trans, &m, &n, &ldc );
lwork = MAX(m,n);
ldc_r = n+2;
side_i = side;
uplo_i = uplo;
trans_i = trans;
m_i = m;
n_i = n;
ldc_i = ldc;
/* Allocate memory for the LAPACK routine arrays */
ap = (lapack_complex_float *)
LAPACKE_malloc( ((m*(m+1)/2)) * sizeof(lapack_complex_float) );
tau = (lapack_complex_float *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_float) );
c = (lapack_complex_float *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_float) );
work = (lapack_complex_float *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
/* Allocate memory for the C interface function arrays */
ap_i = (lapack_complex_float *)
LAPACKE_malloc( ((m*(m+1)/2)) * sizeof(lapack_complex_float) );
tau_i = (lapack_complex_float *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_float) );
c_i = (lapack_complex_float *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_float) );
work_i = (lapack_complex_float *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
/* Allocate memory for the backup arrays */
c_save = (lapack_complex_float *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_float) );
/* Allocate memory for the row-major arrays */
ap_r = (lapack_complex_float *)
LAPACKE_malloc( m*(m+1)/2 * sizeof(lapack_complex_float) );
c_r = (lapack_complex_float *)
LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_ap( (m*(m+1)/2), ap );
init_tau( (m-1), tau );
init_c( ldc*n, c );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldc*n; i++ ) {
c_save[i] = c[i];
}
/* Call the LAPACK routine */
cupmtr_( &side, &uplo, &trans, &m, &n, ap, tau, 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 < (m*(m+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cupmtr_work( LAPACK_COL_MAJOR, side_i, uplo_i, trans_i,
m_i, n_i, ap_i, tau_i, c_i, ldc_i, work_i );
failed = compare_cupmtr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to cupmtr\n" );
} else {
printf( "FAILED: column-major middle-level interface to cupmtr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (m*(m+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cupmtr( LAPACK_COL_MAJOR, side_i, uplo_i, trans_i, m_i,
n_i, ap_i, tau_i, c_i, ldc_i );
failed = compare_cupmtr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to cupmtr\n" );
} else {
printf( "FAILED: column-major high-level interface to cupmtr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (m*(m+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, m, ap_i, ap_r );
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_cupmtr_work( LAPACK_ROW_MAJOR, side_i, uplo_i, trans_i,
m_i, n_i, ap_r, tau_i, c_r, ldc_r, work_i );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_cupmtr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to cupmtr\n" );
} else {
printf( "FAILED: row-major middle-level interface to cupmtr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (m*(m+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, m, ap_i, ap_r );
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_cupmtr( LAPACK_ROW_MAJOR, side_i, uplo_i, trans_i, m_i,
n_i, ap_r, tau_i, c_r, ldc_r );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_cupmtr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to cupmtr\n" );
} else {
printf( "FAILED: row-major high-level interface to cupmtr\n" );
}
/* Release memory */
if( ap != NULL ) {
LAPACKE_free( ap );
}
if( ap_i != NULL ) {
LAPACKE_free( ap_i );
}
if( ap_r != NULL ) {
LAPACKE_free( ap_r );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
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;
}
int main(void)
{
/* Local scalars */
char vect, vect_i;
char side, side_i;
char trans, trans_i;
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int k, k_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int ldc, ldc_i;
lapack_int ldc_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
/* Declare scalars */
lapack_int nq;
lapack_int r;
lapack_int i;
int failed;
/* Local arrays */
float *a = NULL, *a_i = NULL;
float *tau = NULL, *tau_i = NULL;
float *c = NULL, *c_i = NULL;
float *work = NULL, *work_i = NULL;
float *c_save = NULL;
float *a_r = NULL;
float *c_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_sormbr( &vect, &side, &trans, &m, &n, &k, &lda, &ldc, &lwork );
nq = LAPACKE_lsame( side, 'l' ) ? m : n;
r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
lda_r = MIN(nq,k)+2;
ldc_r = n+2;
vect_i = vect;
side_i = side;
trans_i = trans;
m_i = m;
n_i = n;
k_i = k;
lda_i = lda;
ldc_i = ldc;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (float *)LAPACKE_malloc( (lda*(MIN(nq,k))) * sizeof(float) );
tau = (float *)LAPACKE_malloc( MIN(nq,k) * sizeof(float) );
c = (float *)LAPACKE_malloc( ldc*n * sizeof(float) );
work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the C interface function arrays */
a_i = (float *)LAPACKE_malloc( (lda*(MIN(nq,k))) * sizeof(float) );
tau_i = (float *)LAPACKE_malloc( MIN(nq,k) * sizeof(float) );
c_i = (float *)LAPACKE_malloc( ldc*n * sizeof(float) );
work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the backup arrays */
c_save = (float *)LAPACKE_malloc( ldc*n * sizeof(float) );
/* Allocate memory for the row-major arrays */
a_r = (float *)LAPACKE_malloc( (r*(MIN(nq,k)+2)) * sizeof(float) );
c_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
/* Initialize input arrays */
init_a( lda*(MIN(nq,k)), a );
init_tau( (MIN(nq,k)), tau );
init_c( ldc*n, c );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldc*n; i++ ) {
c_save[i] = c[i];
}
/* Call the LAPACK routine */
sormbr_( &vect, &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
&lwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*(MIN(nq,k)); i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (MIN(nq,k)); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sormbr_work( LAPACK_COL_MAJOR, vect_i, side_i, trans_i,
m_i, n_i, k_i, a_i, lda_i, tau_i, c_i, ldc_i,
work_i, lwork_i );
failed = compare_sormbr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to sormbr\n" );
} else {
printf( "FAILED: column-major middle-level interface to sormbr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*(MIN(nq,k)); i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (MIN(nq,k)); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sormbr( LAPACK_COL_MAJOR, vect_i, side_i, trans_i, m_i,
n_i, k_i, a_i, lda_i, tau_i, c_i, ldc_i );
failed = compare_sormbr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to sormbr\n" );
} else {
printf( "FAILED: column-major high-level interface to sormbr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*(MIN(nq,k)); i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (MIN(nq,k)); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, r, MIN(nq, k ), a_i, lda, a_r, MIN(nq,
k)+2);
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_sormbr_work( LAPACK_ROW_MAJOR, vect_i, side_i, trans_i,
m_i, n_i, k_i, a_r, lda_r, tau_i, c_r, ldc_r,
work_i, lwork_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_sormbr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to sormbr\n" );
} else {
printf( "FAILED: row-major middle-level interface to sormbr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*(MIN(nq,k)); i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (MIN(nq,k)); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, r, MIN(nq, k ), a_i, lda, a_r, MIN(nq,
k)+2);
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_sormbr( LAPACK_ROW_MAJOR, vect_i, side_i, trans_i, m_i,
n_i, k_i, a_r, lda_r, tau_i, c_r, ldc_r );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_sormbr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to sormbr\n" );
} else {
printf( "FAILED: row-major high-level interface to sormbr\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
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;
}
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;
}
