//--------------------------------------------------------
// global element = global element
//--------------------------------------------------------
void gmove_ge_ge(){
init_a();
init_b();
#pragma xmp barrier
#pragma xmp task on p1
{
#ifdef _MPI3
#pragma xmp gmove in
a[7][8][9] = b[3][4][5];
#endif
#pragma xmp barrier
#pragma xmp task on t1(7,8,9) nocomm
{
if (a[7][8][9] != 3*10000 + 4*100 + 5){
printf("ERROR in gmove_ge_ge\n");
exit(1);
}
}
}
}
//--------------------------------------------------------
// global section = global section
//--------------------------------------------------------
void gmove_gs_gs(){
int result = 0;
init_a();
init_b();
#pragma xmp barrier
#pragma xmp task on p1
{
#ifdef _MPI3
#pragma xmp gmove in
a[0:N/4][N/2:N/2][4:N-5] = b[N/2:N/4:2][0:N/2][0:N-5];
#endif
#pragma xmp barrier
#pragma xmp loop (i,j,k) on t1(i,j,k) reduction (+:result)
for (int i = 0; i < N/4; i++){
for (int j = N/2; j < N; j++){
for (int k = 4; k < N-1; k++){
if (a[i][j][k] != (N/2+i*2)*10000 + (j-N/2)*100 + (k-4)){
result = 1;
}
}
}
}
#pragma xmp task on p1(1,1) nocomm
{
if (result != 0){
printf("ERROR in gmove_gs_gs\n");
exit(1);
}
}
}
}
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 uplo, uplo_i;
lapack_int n, n_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *a = NULL, *a_i = NULL;
lapack_int *ipiv = NULL, *ipiv_i = NULL;
float *work = NULL, *work_i = NULL;
float *a_save = NULL;
lapack_int *ipiv_save = NULL;
float *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_ssytrf( &uplo, &n, &lda, &lwork );
lda_r = n+2;
uplo_i = uplo;
n_i = n;
lda_i = lda;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the C interface function arrays */
a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the backup arrays */
a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
ipiv_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the row-major arrays */
a_r = (float *)LAPACKE_malloc( n*(n+2) * sizeof(float) );
/* Initialize input arrays */
init_a( lda*n, a );
init_ipiv( n, ipiv );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
for( i = 0; i < n; i++ ) {
ipiv_save[i] = ipiv[i];
}
/* Call the LAPACK routine */
ssytrf_( &uplo, &n, a, &lda, ipiv, 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*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_ssytrf_work( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i,
ipiv_i, work_i, lwork_i );
failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to ssytrf\n" );
} else {
printf( "FAILED: column-major middle-level interface to ssytrf\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_ssytrf( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i,
ipiv_i );
failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to ssytrf\n" );
} else {
printf( "FAILED: column-major high-level interface to ssytrf\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_ssytrf_work( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r,
ipiv_i, work_i, lwork_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to ssytrf\n" );
} else {
printf( "FAILED: row-major middle-level interface to ssytrf\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_ssytrf( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r,
ipiv_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to ssytrf\n" );
} else {
printf( "FAILED: row-major high-level interface to ssytrf\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( a_save != NULL ) {
LAPACKE_free( a_save );
}
if( ipiv != NULL ) {
LAPACKE_free( ipiv );
}
if( ipiv_i != NULL ) {
LAPACKE_free( ipiv_i );
}
if( ipiv_save != NULL ) {
LAPACKE_free( ipiv_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
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 lwork, lwork_i;
lapack_int info, info_i;
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 *work = NULL, *work_i = NULL;
lapack_complex_double *a_save = NULL;
lapack_complex_double *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zunglq( &m, &n, &k, &lda, &lwork );
lda_r = n+2;
m_i = m;
n_i = n;
k_i = k;
lda_i = lda;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
tau = (lapack_complex_double *)
LAPACKE_malloc( k * 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*n * sizeof(lapack_complex_double) );
tau_i = (lapack_complex_double *)
LAPACKE_malloc( k * sizeof(lapack_complex_double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the backup arrays */
a_save = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*n, a );
init_tau( k, tau );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
/* Call the LAPACK routine */
zunglq_( &m, &n, &k, a, &lda, tau, 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*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunglq_work( LAPACK_COL_MAJOR, m_i, n_i, k_i, a_i, lda_i,
tau_i, work_i, lwork_i );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zunglq\n" );
} else {
printf( "FAILED: column-major middle-level interface to zunglq\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunglq( LAPACK_COL_MAJOR, m_i, n_i, k_i, a_i, lda_i,
tau_i );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zunglq\n" );
} else {
printf( "FAILED: column-major high-level interface to zunglq\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zunglq_work( LAPACK_ROW_MAJOR, m_i, n_i, k_i, a_r, lda_r,
tau_i, work_i, lwork_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zunglq\n" );
} else {
printf( "FAILED: row-major middle-level interface to zunglq\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zunglq( LAPACK_ROW_MAJOR, m_i, n_i, k_i, a_r, lda_r,
tau_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zunglq\n" );
} else {
printf( "FAILED: row-major high-level interface to zunglq\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( a_save != NULL ) {
LAPACKE_free( a_save );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *a = NULL, *a_i = NULL;
float *d = NULL, *d_i = NULL;
float *e = NULL, *e_i = NULL;
float *tauq = NULL, *tauq_i = NULL;
float *taup = NULL, *taup_i = NULL;
float *work = NULL, *work_i = NULL;
float *a_save = NULL;
float *d_save = NULL;
float *e_save = NULL;
float *tauq_save = NULL;
float *taup_save = NULL;
float *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_sgebrd( &m, &n, &lda, &lwork );
lda_r = n+2;
m_i = m;
n_i = n;
lda_i = lda;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
d = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
e = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
tauq = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
taup = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the C interface function arrays */
a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
d_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
e_i = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
tauq_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
taup_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the backup arrays */
a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
d_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
e_save = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
tauq_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
taup_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
/* Allocate memory for the row-major arrays */
a_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
/* Initialize input arrays */
init_a( lda*n, a );
init_d( (MIN(m,n)), d );
init_e( (MIN(m,n)-1), e );
init_tauq( (MIN(m,n)), tauq );
init_taup( (MIN(m,n)), taup );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_save[i] = d[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_save[i] = e[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_save[i] = tauq[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_save[i] = taup[i];
}
/* Call the LAPACK routine */
sgebrd_( &m, &n, a, &lda, d, e, tauq, taup, 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*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_i[i] = tauq_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_i[i] = taup_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sgebrd_work( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i,
e_i, tauq_i, taup_i, work_i, lwork_i );
failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
info, info_i, lda, m, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to sgebrd\n" );
} else {
printf( "FAILED: column-major middle-level interface to sgebrd\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_i[i] = tauq_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_i[i] = taup_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sgebrd( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i, e_i,
tauq_i, taup_i );
failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
info, info_i, lda, m, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to sgebrd\n" );
} else {
printf( "FAILED: column-major high-level interface to sgebrd\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_i[i] = tauq_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_i[i] = taup_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_sgebrd_work( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i,
e_i, tauq_i, taup_i, work_i, lwork_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
info, info_i, lda, m, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to sgebrd\n" );
} else {
printf( "FAILED: row-major middle-level interface to sgebrd\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_i[i] = tauq_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_i[i] = taup_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_sgebrd( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i, e_i,
tauq_i, taup_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
info, info_i, lda, m, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to sgebrd\n" );
} else {
printf( "FAILED: row-major high-level interface to sgebrd\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( a_save != NULL ) {
LAPACKE_free( a_save );
}
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( tauq != NULL ) {
LAPACKE_free( tauq );
}
if( tauq_i != NULL ) {
LAPACKE_free( tauq_i );
}
if( tauq_save != NULL ) {
LAPACKE_free( tauq_save );
}
if( taup != NULL ) {
LAPACKE_free( taup );
}
if( taup_i != NULL ) {
LAPACKE_free( taup_i );
}
if( taup_save != NULL ) {
LAPACKE_free( taup_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 lda, lda_i;
lapack_int lda_r;
double anorm, anorm_i;
double rcond, rcond_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
double *rwork = NULL, *rwork_i = NULL;
lapack_complex_double *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zpocon( &uplo, &n, &lda, &anorm );
lda_r = n+2;
uplo_i = uplo;
n_i = n;
lda_i = lda;
anorm_i = anorm;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
work = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
rwork = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
rwork_i = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*n, a );
init_work( 2*n, work );
init_rwork( n, rwork );
/* Call the LAPACK routine */
zpocon_( &uplo, &n, a, &lda, &anorm, &rcond, work, rwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_zpocon_work( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i,
anorm_i, &rcond_i, work_i, rwork_i );
failed = compare_zpocon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zpocon\n" );
} else {
printf( "FAILED: column-major middle-level interface to zpocon\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_zpocon( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i, anorm_i,
&rcond_i );
failed = compare_zpocon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zpocon\n" );
} else {
printf( "FAILED: column-major high-level interface to zpocon\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zpocon_work( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r,
anorm_i, &rcond_i, work_i, rwork_i );
failed = compare_zpocon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zpocon\n" );
} else {
printf( "FAILED: row-major middle-level interface to zpocon\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zpocon( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r, anorm_i,
&rcond_i );
failed = compare_zpocon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zpocon\n" );
} else {
printf( "FAILED: row-major high-level interface to zpocon\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( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( rwork != NULL ) {
LAPACKE_free( rwork );
}
if( rwork_i != NULL ) {
LAPACKE_free( rwork_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;
char trans, trans_i;
char diag, diag_i;
lapack_int n, n_i;
lapack_int nrhs, nrhs_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int ldb, ldb_i;
lapack_int ldb_r;
lapack_int ldx, ldx_i;
lapack_int ldx_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_complex_double *b = NULL, *b_i = NULL;
lapack_complex_double *x = NULL, *x_i = NULL;
double *ferr = NULL, *ferr_i = NULL;
double *berr = NULL, *berr_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
double *rwork = NULL, *rwork_i = NULL;
double *ferr_save = NULL;
double *berr_save = NULL;
lapack_complex_double *a_r = NULL;
lapack_complex_double *b_r = NULL;
lapack_complex_double *x_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_ztrrfs( &uplo, &trans, &diag, &n, &nrhs, &lda, &ldb, &ldx );
lda_r = n+2;
ldb_r = nrhs+2;
ldx_r = nrhs+2;
uplo_i = uplo;
trans_i = trans;
diag_i = diag;
n_i = n;
nrhs_i = nrhs;
lda_i = lda;
ldb_i = ldb;
ldx_i = ldx;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
b = (lapack_complex_double *)
LAPACKE_malloc( ldb*nrhs * sizeof(lapack_complex_double) );
x = (lapack_complex_double *)
LAPACKE_malloc( ldx*nrhs * sizeof(lapack_complex_double) );
ferr = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
berr = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
work = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
rwork = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
b_i = (lapack_complex_double *)
LAPACKE_malloc( ldb*nrhs * sizeof(lapack_complex_double) );
x_i = (lapack_complex_double *)
LAPACKE_malloc( ldx*nrhs * sizeof(lapack_complex_double) );
ferr_i = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
berr_i = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
rwork_i = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the backup arrays */
ferr_save = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
berr_save = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
b_r = (lapack_complex_double *)
LAPACKE_malloc( n*(nrhs+2) * sizeof(lapack_complex_double) );
x_r = (lapack_complex_double *)
LAPACKE_malloc( n*(nrhs+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*n, a );
init_b( ldb*nrhs, b );
init_x( ldx*nrhs, x );
init_ferr( nrhs, ferr );
init_berr( nrhs, berr );
init_work( 2*n, work );
init_rwork( n, rwork );
/* Backup the ouptut arrays */
for( i = 0; i < nrhs; i++ ) {
ferr_save[i] = ferr[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_save[i] = berr[i];
}
/* Call the LAPACK routine */
ztrrfs_( &uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb, x, &ldx, ferr,
berr, work, rwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_ztrrfs_work( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, a_i, lda_i, b_i, ldb_i, x_i,
ldx_i, ferr_i, berr_i, work_i, rwork_i );
failed = compare_ztrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to ztrrfs\n" );
} else {
printf( "FAILED: column-major middle-level interface to ztrrfs\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_ztrrfs( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, a_i, lda_i, b_i, ldb_i, x_i, ldx_i, ferr_i,
berr_i );
failed = compare_ztrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to ztrrfs\n" );
} else {
printf( "FAILED: column-major high-level interface to ztrrfs\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_ztrrfs_work( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, a_r, lda_r, b_r, ldb_r, x_r,
ldx_r, ferr_i, berr_i, work_i, rwork_i );
failed = compare_ztrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to ztrrfs\n" );
} else {
printf( "FAILED: row-major middle-level interface to ztrrfs\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_ztrrfs( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, a_r, lda_r, b_r, ldb_r, x_r, ldx_r, ferr_i,
berr_i );
failed = compare_ztrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to ztrrfs\n" );
} else {
printf( "FAILED: row-major high-level interface to ztrrfs\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( b != NULL ) {
LAPACKE_free( b );
}
if( b_i != NULL ) {
LAPACKE_free( b_i );
}
if( b_r != NULL ) {
LAPACKE_free( b_r );
}
if( x != NULL ) {
LAPACKE_free( x );
}
if( x_i != NULL ) {
LAPACKE_free( x_i );
}
if( x_r != NULL ) {
LAPACKE_free( x_r );
}
if( ferr != NULL ) {
LAPACKE_free( ferr );
}
if( ferr_i != NULL ) {
LAPACKE_free( ferr_i );
}
if( ferr_save != NULL ) {
LAPACKE_free( ferr_save );
}
if( berr != NULL ) {
LAPACKE_free( berr );
}
if( berr_i != NULL ) {
LAPACKE_free( berr_i );
}
if( berr_save != NULL ) {
LAPACKE_free( berr_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( rwork != NULL ) {
LAPACKE_free( rwork );
}
if( rwork_i != NULL ) {
LAPACKE_free( rwork_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
lapack_int itype, itype_i;
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int ldb, ldb_i;
lapack_int ldb_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_float *a = NULL, *a_i = NULL;
lapack_complex_float *b = NULL, *b_i = NULL;
lapack_complex_float *a_save = NULL;
lapack_complex_float *a_r = NULL;
lapack_complex_float *b_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_chegst( &itype, &uplo, &n, &lda, &ldb );
lda_r = n+2;
ldb_r = n+2;
itype_i = itype;
uplo_i = uplo;
n_i = n;
lda_i = lda;
ldb_i = ldb;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_float *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) );
b = (lapack_complex_float *)
LAPACKE_malloc( ldb*n * sizeof(lapack_complex_float) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_float *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) );
b_i = (lapack_complex_float *)
LAPACKE_malloc( ldb*n * sizeof(lapack_complex_float) );
/* Allocate memory for the backup arrays */
a_save = (lapack_complex_float *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_float) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_float *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_float) );
b_r = (lapack_complex_float *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_a( lda*n, a );
init_b( ldb*n, b );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
/* Call the LAPACK routine */
chegst_( &itype, &uplo, &n, a, &lda, b, &ldb, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < ldb*n; i++ ) {
b_i[i] = b[i];
}
info_i = LAPACKE_chegst_work( LAPACK_COL_MAJOR, itype_i, uplo_i, n_i, a_i,
lda_i, b_i, ldb_i );
failed = compare_chegst( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to chegst\n" );
} else {
printf( "FAILED: column-major middle-level interface to chegst\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < ldb*n; i++ ) {
b_i[i] = b[i];
}
info_i = LAPACKE_chegst( LAPACK_COL_MAJOR, itype_i, uplo_i, n_i, a_i, lda_i,
b_i, ldb_i );
failed = compare_chegst( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to chegst\n" );
} else {
printf( "FAILED: column-major high-level interface to chegst\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < ldb*n; i++ ) {
b_i[i] = b[i];
}
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_i, ldb, b_r, n+2 );
info_i = LAPACKE_chegst_work( LAPACK_ROW_MAJOR, itype_i, uplo_i, n_i, a_r,
lda_r, b_r, ldb_r );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_chegst( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to chegst\n" );
} else {
printf( "FAILED: row-major middle-level interface to chegst\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < ldb*n; i++ ) {
b_i[i] = b[i];
}
/* Init row_major arrays */
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_i, ldb, b_r, n+2 );
info_i = LAPACKE_chegst( LAPACK_ROW_MAJOR, itype_i, uplo_i, n_i, a_r, lda_r,
b_r, ldb_r );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_chegst( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to chegst\n" );
} else {
printf( "FAILED: row-major high-level interface to chegst\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( a_save != NULL ) {
LAPACKE_free( a_save );
}
if( b != NULL ) {
LAPACKE_free( b );
}
if( b_i != NULL ) {
LAPACKE_free( b_i );
}
if( b_r != NULL ) {
LAPACKE_free( b_r );
}
return 0;
}
int main(void)
{
/* Local scalars */
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *a = NULL, *a_i = NULL;
lapack_int *jpvt = NULL, *jpvt_i = NULL;
float *tau = NULL, *tau_i = NULL;
float *work = NULL, *work_i = NULL;
float *a_save = NULL;
lapack_int *jpvt_save = NULL;
float *tau_save = NULL;
float *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_sgeqpf( &m, &n, &lda );
lda_r = n+2;
m_i = m;
n_i = n;
lda_i = lda;
/* Allocate memory for the LAPACK routine arrays */
a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
jpvt = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
tau = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
work = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
/* Allocate memory for the C interface function arrays */
a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
jpvt_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
tau_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
/* Allocate memory for the backup arrays */
a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
jpvt_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
tau_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
/* Allocate memory for the row-major arrays */
a_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
/* Initialize input arrays */
init_a( lda*n, a );
init_jpvt( n, jpvt );
init_tau( (MIN(m,n)), tau );
init_work( 3*n, work );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
for( i = 0; i < n; i++ ) {
jpvt_save[i] = jpvt[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_save[i] = tau[i];
}
/* Call the LAPACK routine */
sgeqpf_( &m, &n, a, &lda, jpvt, tau, work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
jpvt_i[i] = jpvt_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_i[i] = tau_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sgeqpf_work( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i,
jpvt_i, tau_i, work_i );
failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
lda, m, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to sgeqpf\n" );
} else {
printf( "FAILED: column-major middle-level interface to sgeqpf\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
jpvt_i[i] = jpvt_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_i[i] = tau_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sgeqpf( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, jpvt_i,
tau_i );
failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
lda, m, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to sgeqpf\n" );
} else {
printf( "FAILED: column-major high-level interface to sgeqpf\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
jpvt_i[i] = jpvt_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_i[i] = tau_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_sgeqpf_work( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r,
jpvt_i, tau_i, work_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
lda, m, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to sgeqpf\n" );
} else {
printf( "FAILED: row-major middle-level interface to sgeqpf\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
jpvt_i[i] = jpvt_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_i[i] = tau_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_sgeqpf( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, jpvt_i,
tau_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
lda, m, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to sgeqpf\n" );
} else {
printf( "FAILED: row-major high-level interface to sgeqpf\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( a_save != NULL ) {
LAPACKE_free( a_save );
}
if( jpvt != NULL ) {
LAPACKE_free( jpvt );
}
if( jpvt_i != NULL ) {
LAPACKE_free( jpvt_i );
}
if( jpvt_save != NULL ) {
LAPACKE_free( jpvt_save );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
if( tau_save != NULL ) {
LAPACKE_free( tau_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
