lapack_int LAPACKE_sgebal_work( int matrix_order, char job, lapack_int n,
float* a, lapack_int lda, lapack_int* ilo,
lapack_int* ihi, float* scale )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sgebal( &job, &n, a, &lda, ilo, ihi, scale, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
float* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -5;
LAPACKE_xerbla( "LAPACKE_sgebal_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
LAPACKE_lsame( job, 's' ) ) {
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
}
/* Transpose input matrices */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
LAPACKE_lsame( job, 's' ) ) {
LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
}
/* Call LAPACK function and adjust info */
LAPACK_sgebal( &job, &n, a_t, &lda_t, ilo, ihi, scale, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
LAPACKE_lsame( job, 's' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
}
/* Release memory and exit */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) ||
LAPACKE_lsame( job, 's' ) ) {
LAPACKE_free( a_t );
}
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sgebal_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sgebal_work", info );
}
return info;
}
lapack_int LAPACKE_stptrs_work( int matrix_order, char uplo, char trans,
char diag, lapack_int n, lapack_int nrhs,
const float* ap, float* b, lapack_int ldb )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_stptrs( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldb_t = MAX(1,n);
float* b_t = NULL;
float* ap_t = NULL;
/* Check leading dimension(s) */
if( ldb < nrhs ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_stptrs_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
ap_t = (float*)
LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
if( ap_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
LAPACKE_stp_trans( matrix_order, uplo, diag, n, ap, ap_t );
/* Call LAPACK function and adjust info */
LAPACK_stptrs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t,
&info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
/* Release memory and exit */
LAPACKE_free( ap_t );
exit_level_1:
LAPACKE_free( b_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_stptrs_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_stptrs_work", info );
}
return info;
}
lapack_int LAPACKE_ssyevd_2stage_work( int matrix_layout, char jobz, char uplo,
lapack_int n, float* a, lapack_int lda,
float* w, float* work, lapack_int lwork,
lapack_int* iwork, lapack_int liwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_ssyevd_2stage( &jobz, &uplo, &n, a, &lda, w, work, &lwork, iwork,
&liwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
float* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_ssyevd_2stage_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( liwork == -1 || lwork == -1 ) {
LAPACK_ssyevd_2stage( &jobz, &uplo, &n, a, &lda_t, w, work, &lwork, iwork,
&liwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_ssyevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork,
&liwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
/* Release memory and exit */
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_ssyevd_2stage_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_ssyevd_2stage_work", info );
}
return info;
}
lapack_int LAPACKE_sorgbr_work( int matrix_order, char vect, lapack_int m,
lapack_int n, lapack_int k, float* a,
lapack_int lda, const float* tau, float* work,
lapack_int lwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sorgbr( &vect, &m, &n, &k, a, &lda, tau, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,m);
float* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_sorgbr_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_sorgbr( &vect, &m, &n, &k, a, &lda_t, tau, work, &lwork,
&info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_sorgbr( &vect, &m, &n, &k, a_t, &lda_t, tau, work, &lwork,
&info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
/* Release memory and exit */
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sorgbr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sorgbr_work", info );
}
return info;
}
lapack_int LAPACKE_slatms_work( int matrix_order, lapack_int m, lapack_int n,
char dist, lapack_int* iseed, char sym,
float* d, lapack_int mode, float cond,
float dmax, lapack_int kl, lapack_int ku,
char pack, float* a, lapack_int lda,
float* work )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_slatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl,
&ku, &pack, a, &lda, work, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,m);
float* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -15;
LAPACKE_xerbla( "LAPACKE_slatms_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_slatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl,
&ku, &pack, a_t, &lda_t, work, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
/* Release memory and exit */
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_slatms_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_slatms_work", info );
}
return info;
}
lapack_int LAPACKE_sgebak_work( int matrix_order, char job, char side,
lapack_int n, lapack_int ilo, lapack_int ihi,
const float* scale, lapack_int m, float* v,
lapack_int ldv )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v, &ldv, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldv_t = MAX(1,n);
float* v_t = NULL;
/* Check leading dimension(s) */
if( ldv < m ) {
info = -10;
LAPACKE_xerbla( "LAPACKE_sgebak_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,m) );
if( v_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, n, m, v, ldv, v_t, ldv_t );
/* Call LAPACK function and adjust info */
LAPACK_sgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v_t, &ldv_t,
&info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv );
/* Release memory and exit */
LAPACKE_free( v_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sgebak_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sgebak_work", info );
}
return info;
}
lapack_int LAPACKE_spteqr_work( int matrix_layout, char compz, lapack_int n,
float* d, float* e, float* z, lapack_int ldz,
float* work )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_spteqr( &compz, &n, d, e, z, &ldz, work, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldz_t = MAX(1,n);
float* z_t = NULL;
/* Check leading dimension(s) */
if( ldz < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_spteqr_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
if( z_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
if( LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t );
}
/* Call LAPACK function and adjust info */
LAPACK_spteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
/* Release memory and exit */
LAPACKE_free( z_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_spteqr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_spteqr_work", info );
}
return info;
}
lapack_int LAPACKE_clacp2_work( int matrix_layout, char uplo, lapack_int m,
lapack_int n, const float* a, lapack_int lda,
lapack_complex_float* b, lapack_int ldb )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_clacp2( &uplo, &m, &n, a, &lda, b, &ldb );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,m);
lapack_int ldb_t = MAX(1,m);
float* a_t = NULL;
lapack_complex_float* b_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_clacp2_work", info );
return info;
}
if( ldb < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_clacp2_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
b_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_clacp2( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t );
info = 0; /* LAPACK call is ok! */
/* Transpose output matrices */
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
/* Release memory and exit */
LAPACKE_free( b_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_clacp2_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_clacp2_work", info );
}
return info;
}
lapack_int LAPACKE_ssfrk_work( int matrix_order, char transr, char uplo,
char trans, lapack_int n, lapack_int k,
float alpha, const float* a, lapack_int lda,
float beta, float* c )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_ssfrk( &transr, &uplo, &trans, &n, &k, &alpha, a, &lda, &beta,
c );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int na = LAPACKE_lsame( trans, 'n' ) ? n : k;
lapack_int ka = LAPACKE_lsame( trans, 'n' ) ? k : n;
lapack_int lda_t = MAX(1,na);
float* a_t = NULL;
float* c_t = NULL;
/* Check leading dimension(s) */
if( lda < ka ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_ssfrk_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,ka) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
c_t = (float*)
LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
if( c_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, na, ka, a, lda, a_t, lda_t );
LAPACKE_spf_trans( matrix_order, transr, uplo, n, c, c_t );
/* Call LAPACK function and adjust info */
LAPACK_ssfrk( &transr, &uplo, &trans, &n, &k, &alpha, a_t, &lda_t,
&beta, c_t );
info = 0; /* LAPACK call is ok! */
/* Transpose output matrices */
LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c );
/* Release memory and exit */
LAPACKE_free( c_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_ssfrk_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_ssfrk_work", info );
}
return info;
}
lapack_int LAPACKE_sgeqpf_work( int matrix_layout, lapack_int m, lapack_int n,
float* a, lapack_int lda, lapack_int* jpvt,
float* tau, float* work )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sgeqpf( &m, &n, a, &lda, jpvt, tau, work, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,m);
float* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -5;
LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_sgeqpf( &m, &n, a_t, &lda_t, jpvt, tau, work, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
/* Release memory and exit */
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info );
}
return info;
}
lapack_int LAPACKE_slaswp_work( int matrix_layout, lapack_int n, float* a,
lapack_int lda, lapack_int k1, lapack_int k2,
const lapack_int* ipiv, lapack_int incx )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_slaswp( &n, a, &lda, &k1, &k2, ipiv, &incx );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,lda);
float* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -4;
LAPACKE_xerbla( "LAPACKE_slaswp_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_slaswp( &n, a_t, &lda_t, &k1, &k2, ipiv, &incx );
info = 0; /* LAPACK call is ok! */
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda );
/* Release memory and exit */
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_slaswp_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_slaswp_work", info );
}
return info;
}
lapack_int LAPACKE_stfttr_work( int matrix_order, char transr, char uplo,
lapack_int n, const float* arf, float* a,
lapack_int lda )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_stfttr( &transr, &uplo, &n, arf, a, &lda, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
float* a_t = NULL;
float* arf_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_stfttr_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
arf_t = (float*)
LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
if( arf_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_spf_trans( matrix_order, transr, uplo, n, arf, arf_t );
/* Call LAPACK function and adjust info */
LAPACK_stfttr( &transr, &uplo, &n, arf_t, a_t, &lda_t, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
/* Release memory and exit */
LAPACKE_free( arf_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_stfttr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_stfttr_work", info );
}
return info;
}
void LAPACKE_shs_trans( int matrix_order, lapack_int n,
const float *in, lapack_int ldin,
float *out, lapack_int ldout )
{
if( in == NULL || out == NULL ) return;
/* Convert subdiagonal first */
if( matrix_order == LAPACK_COL_MAJOR ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1,
&out[ldout], ldout+1 );
} else if ( matrix_order == LAPACK_ROW_MAJOR ) {
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1,
&out[1], ldout+1 );
} else {
return;
}
/* Convert upper triangular. */
LAPACKE_str_trans( matrix_order, 'u', 'n', n, in, ldin, out, ldout);
}
lapack_int LAPACKE_spoequ_work( int matrix_order, lapack_int n, const float* a,
lapack_int lda, float* s, float* scond,
float* amax )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_spoequ( &n, a, &lda, s, scond, amax, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
float* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -4;
LAPACKE_xerbla( "LAPACKE_spoequ_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_spoequ( &n, a_t, &lda_t, s, scond, amax, &info );
if( info < 0 ) {
info = info - 1;
}
/* Release memory and exit */
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_spoequ_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_spoequ_work", info );
}
return info;
}
float LAPACKE_slange_work( int matrix_layout, char norm, lapack_int m,
lapack_int n, const float* a, lapack_int lda,
float* work )
{
lapack_int info = 0;
float res = 0.;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
res = LAPACK_slange( &norm, &m, &n, a, &lda, work );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,m);
float* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_slange_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
res = LAPACK_slange( &norm, &m, &n, a_t, &lda_t, work );
info = 0; /* LAPACK call is ok! */
/* Release memory and exit */
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_slange_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_slange_work", info );
}
return res;
}
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 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 */
float *ap = NULL, *ap_i = NULL;
float *b = NULL, *b_i = NULL;
float *x = NULL, *x_i = NULL;
float *ferr = NULL, *ferr_i = NULL;
float *berr = NULL, *berr_i = NULL;
float *work = NULL, *work_i = NULL;
lapack_int *iwork = NULL, *iwork_i = NULL;
float *ferr_save = NULL;
float *berr_save = NULL;
float *ap_r = NULL;
float *b_r = NULL;
float *x_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_stprfs( &uplo, &trans, &diag, &n, &nrhs, &ldb, &ldx );
ldb_r = nrhs+2;
ldx_r = nrhs+2;
uplo_i = uplo;
trans_i = trans;
diag_i = diag;
n_i = n;
nrhs_i = nrhs;
ldb_i = ldb;
ldx_i = ldx;
/* Allocate memory for the LAPACK routine arrays */
ap = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
b = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
x = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) );
ferr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
berr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
work = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the C interface function arrays */
ap_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
b_i = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
x_i = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) );
ferr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
berr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the backup arrays */
ferr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
berr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
/* Allocate memory for the row-major arrays */
ap_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) );
b_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) );
x_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) );
/* Initialize input arrays */
init_ap( (n*(n+1)/2), ap );
init_b( ldb*nrhs, b );
init_x( ldx*nrhs, x );
init_ferr( nrhs, ferr );
init_berr( nrhs, berr );
init_work( 3*n, work );
init_iwork( n, iwork );
/* 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 */
stprfs_( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, x, &ldx, ferr, berr,
work, iwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[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 < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_stprfs_work( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i,
ferr_i, berr_i, work_i, iwork_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to stprfs\n" );
} else {
printf( "FAILED: column-major middle-level interface to stprfs\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[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 < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_stprfs( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i, ferr_i,
berr_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to stprfs\n" );
} else {
printf( "FAILED: column-major high-level interface to stprfs\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[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 < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_stprfs_work( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r,
ferr_i, berr_i, work_i, iwork_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to stprfs\n" );
} else {
printf( "FAILED: row-major middle-level interface to stprfs\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[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 < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
/* Init row_major arrays */
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_stprfs( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r, ferr_i,
berr_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to stprfs\n" );
} else {
printf( "FAILED: row-major high-level interface to stprfs\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( 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( iwork != NULL ) {
LAPACKE_free( iwork );
}
if( iwork_i != NULL ) {
LAPACKE_free( iwork_i );
}
return 0;
}
lapack_int LAPACKE_cposvxx_work( int matrix_layout, char fact, char uplo,
lapack_int n, lapack_int nrhs,
lapack_complex_float* a, lapack_int lda,
lapack_complex_float* af, lapack_int ldaf,
char* equed, float* s, lapack_complex_float* b,
lapack_int ldb, lapack_complex_float* x,
lapack_int ldx, float* rcond, float* rpvgrw,
float* berr, lapack_int n_err_bnds,
float* err_bnds_norm, float* err_bnds_comp,
lapack_int nparams, float* params,
lapack_complex_float* work, float* rwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_cposvxx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, equed, s,
b, &ldb, x, &ldx, rcond, rpvgrw, berr, &n_err_bnds,
err_bnds_norm, err_bnds_comp, &nparams, params, work,
rwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
lapack_int ldaf_t = MAX(1,n);
lapack_int ldb_t = MAX(1,n);
lapack_int ldx_t = MAX(1,n);
lapack_complex_float* a_t = NULL;
lapack_complex_float* af_t = NULL;
lapack_complex_float* b_t = NULL;
lapack_complex_float* x_t = NULL;
float* err_bnds_norm_t = NULL;
float* err_bnds_comp_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_cposvxx_work", info );
return info;
}
if( ldaf < n ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_cposvxx_work", info );
return info;
}
if( ldb < nrhs ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_cposvxx_work", info );
return info;
}
if( ldx < nrhs ) {
info = -15;
LAPACKE_xerbla( "LAPACKE_cposvxx_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
af_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * ldaf_t * MAX(1,n) );
if( af_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
b_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
ldb_t * MAX(1,nrhs) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
x_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
ldx_t * MAX(1,nrhs) );
if( x_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_3;
}
err_bnds_norm_t = (float*)
LAPACKE_malloc( sizeof(float) * nrhs * MAX(1,n_err_bnds) );
if( err_bnds_norm_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_4;
}
err_bnds_comp_t = (float*)
LAPACKE_malloc( sizeof(float) * nrhs * MAX(1,n_err_bnds) );
if( err_bnds_comp_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_5;
}
/* Transpose input matrices */
LAPACKE_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
if( LAPACKE_lsame( fact, 'f' ) ) {
LAPACKE_cpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t );
}
LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_cposvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, berr,
&n_err_bnds, err_bnds_norm_t, err_bnds_comp_t, &nparams,
params, work, rwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) {
LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
}
if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af,
ldaf );
}
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t,
nrhs, err_bnds_norm, n_err_bnds );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t,
nrhs, err_bnds_comp, n_err_bnds );
/* Release memory and exit */
LAPACKE_free( err_bnds_comp_t );
exit_level_5:
LAPACKE_free( err_bnds_norm_t );
exit_level_4:
LAPACKE_free( x_t );
exit_level_3:
LAPACKE_free( b_t );
exit_level_2:
LAPACKE_free( af_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cposvxx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_cposvxx_work", info );
}
return info;
}
lapack_int LAPACKE_spbtrs_work( int matrix_layout, char uplo, lapack_int n,
lapack_int kd, lapack_int nrhs, const float* ab,
lapack_int ldab, float* b, lapack_int ldb )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_spbtrs( &uplo, &n, &kd, &nrhs, ab, &ldab, b, &ldb, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldab_t = MAX(1,kd+1);
lapack_int ldb_t = MAX(1,n);
float* ab_t = NULL;
float* b_t = NULL;
/* Check leading dimension(s) */
if( ldab < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_spbtrs_work", info );
return info;
}
if( ldb < nrhs ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_spbtrs_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
if( ab_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_spb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t );
LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_spbtrs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t,
&info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
/* Release memory and exit */
LAPACKE_free( b_t );
exit_level_1:
LAPACKE_free( ab_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_spbtrs_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_spbtrs_work", info );
}
return info;
}
lapack_int LAPACKE_ssbevx_work( int matrix_layout, char jobz, char range,
char uplo, lapack_int n, lapack_int kd,
float* ab, lapack_int ldab, float* q,
lapack_int ldq, float vl, float vu,
lapack_int il, lapack_int iu, float abstol,
lapack_int* m, float* w, float* z,
lapack_int ldz, float* work, lapack_int* iwork,
lapack_int* ifail )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_ssbevx( &jobz, &range, &uplo, &n, &kd, ab, &ldab, q, &ldq, &vl,
&vu, &il, &iu, &abstol, m, w, z, &ldz, work, iwork,
ifail, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int ldab_t = MAX(1,kd+1);
lapack_int ldq_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
float* ab_t = NULL;
float* q_t = NULL;
float* z_t = NULL;
/* Check leading dimension(s) */
if( ldab < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
return info;
}
if( ldq < n ) {
info = -10;
LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
return info;
}
if( ldz < ncols_z ) {
info = -19;
LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) );
if( ab_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
if( LAPACKE_lsame( jobz, 'v' ) ) {
q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
if( q_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
}
if( LAPACKE_lsame( jobz, 'v' ) ) {
z_t = (float*)
LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
if( z_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
/* Transpose input matrices */
LAPACKE_ssb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t );
/* Call LAPACK function and adjust info */
LAPACK_ssbevx( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t,
&ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t,
work, iwork, ifail, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab,
ldab );
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
}
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
ldz );
}
/* Release memory and exit */
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_free( z_t );
}
exit_level_2:
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_free( q_t );
}
exit_level_1:
LAPACKE_free( ab_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_ssbevx_work", info );
}
return info;
}
lapack_int LAPACKE_sormbr_work( int matrix_layout, char vect, char side,
char trans, lapack_int m, lapack_int n,
lapack_int k, const float* a, lapack_int lda,
const float* tau, float* c, lapack_int ldc,
float* work, lapack_int lwork )
{
lapack_int info = 0;
lapack_int nq, r;
lapack_int lda_t, ldc_t;
float *a_t = NULL, *c_t = NULL;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sormbr( &vect, &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc,
work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
nq = LAPACKE_lsame( side, 'l' ) ? m : n;
r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
lda_t = MAX(1,r);
ldc_t = MAX(1,m);
/* Check leading dimension(s) */
if( lda < MIN(nq,k) ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_sormbr_work", info );
return info;
}
if( ldc < n ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_sormbr_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_sormbr( &vect, &side, &trans, &m, &n, &k, a, &lda_t, tau, c,
&ldc_t, work, &lwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)
LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,MIN(nq,k)) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) );
if( c_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_layout, r, MIN(nq,k), a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */
LAPACK_sormbr( &vect, &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t,
&ldc_t, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
/* Release memory and exit */
LAPACKE_free( c_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sormbr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sormbr_work", info );
}
return info;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int nrhs, nrhs_i;
lapack_int ldb, ldb_i;
lapack_int ldb_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *ap = NULL, *ap_i = NULL;
lapack_int *ipiv = NULL, *ipiv_i = NULL;
float *b = NULL, *b_i = NULL;
float *b_save = NULL;
float *ap_r = NULL;
float *b_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_ssptrs( &uplo, &n, &nrhs, &ldb );
ldb_r = nrhs+2;
uplo_i = uplo;
n_i = n;
nrhs_i = nrhs;
ldb_i = ldb;
/* Allocate memory for the LAPACK routine arrays */
ap = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
b = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
/* Allocate memory for the C interface function arrays */
ap_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
b_i = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
/* Allocate memory for the backup arrays */
b_save = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
/* Allocate memory for the row-major arrays */
ap_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) );
b_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) );
/* Initialize input arrays */
init_ap( (n*(n+1)/2), ap );
init_ipiv( n, ipiv );
init_b( ldb*nrhs, b );
/* Backup the ouptut arrays */
for( i = 0; i < ldb*nrhs; i++ ) {
b_save[i] = b[i];
}
/* Call the LAPACK routine */
ssptrs_( &uplo, &n, &nrhs, ap, ipiv, b, &ldb, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b_save[i];
}
info_i = LAPACKE_ssptrs_work( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, ap_i,
ipiv_i, b_i, ldb_i );
failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to ssptrs\n" );
} else {
printf( "FAILED: column-major middle-level interface to ssptrs\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b_save[i];
}
info_i = LAPACKE_ssptrs( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, ap_i,
ipiv_i, b_i, ldb_i );
failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to ssptrs\n" );
} else {
printf( "FAILED: column-major high-level interface to ssptrs\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b_save[i];
}
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
info_i = LAPACKE_ssptrs_work( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, ap_r,
ipiv_i, b_r, ldb_r );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, b_r, nrhs+2, b_i, ldb );
failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to ssptrs\n" );
} else {
printf( "FAILED: row-major middle-level interface to ssptrs\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b_save[i];
}
/* Init row_major arrays */
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
info_i = LAPACKE_ssptrs( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, ap_r,
ipiv_i, b_r, ldb_r );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, b_r, nrhs+2, b_i, ldb );
failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to ssptrs\n" );
} else {
printf( "FAILED: row-major high-level interface to ssptrs\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( ipiv != NULL ) {
LAPACKE_free( ipiv );
}
if( ipiv_i != NULL ) {
LAPACKE_free( ipiv_i );
}
if( b != NULL ) {
LAPACKE_free( b );
}
if( b_i != NULL ) {
LAPACKE_free( b_i );
}
if( b_r != NULL ) {
LAPACKE_free( b_r );
}
if( b_save != NULL ) {
LAPACKE_free( b_save );
}
return 0;
}
lapack_int LAPACKE_sstevr_work( int matrix_layout, char jobz, char range,
lapack_int n, float* d, float* e, float vl,
float vu, lapack_int il, lapack_int iu,
float abstol, lapack_int* m, float* w, float* z,
lapack_int ldz, lapack_int* isuppz, float* work,
lapack_int lwork, lapack_int* iwork,
lapack_int liwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sstevr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
w, z, &ldz, isuppz, work, &lwork, iwork, &liwork,
&info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int ldz_t = MAX(1,n);
float* z_t = NULL;
/* Check leading dimension(s) */
if( ldz < ncols_z ) {
info = -15;
LAPACKE_xerbla( "LAPACKE_sstevr_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( liwork == -1 || lwork == -1 ) {
LAPACK_sstevr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol,
m, w, z, &ldz_t, isuppz, work, &lwork, iwork,
&liwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( jobz, 'v' ) ) {
z_t = (float*)
LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
if( z_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
}
/* Call LAPACK function and adjust info */
LAPACK_sstevr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, &abstol, m,
w, z_t, &ldz_t, isuppz, work, &lwork, iwork, &liwork,
&info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
ldz );
}
/* Release memory and exit */
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_free( z_t );
}
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sstevr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sstevr_work", info );
}
return info;
}
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;
}
lapack_int LAPACKE_stfsm_work( int matrix_layout, char transr, char side,
char uplo, char trans, char diag, lapack_int m,
lapack_int n, float alpha, const float* a,
float* b, lapack_int ldb )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a,
b, &ldb );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldb_t = MAX(1,m);
float* b_t = NULL;
float* a_t = NULL;
/* Check leading dimension(s) */
if( ldb < n ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_stfsm_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
if( IS_S_NONZERO(alpha) ) {
a_t = (float*)
LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
}
/* Transpose input matrices */
if( IS_S_NONZERO(alpha) ) {
LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
}
if( IS_S_NONZERO(alpha) ) {
LAPACKE_stf_trans( matrix_layout, transr, uplo, diag, n, a, a_t );
}
/* Call LAPACK function and adjust info */
LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
b_t, &ldb_t );
info = 0; /* LAPACK call is ok! */
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
/* Release memory and exit */
if( IS_S_NONZERO(alpha) ) {
LAPACKE_free( a_t );
}
exit_level_1:
LAPACKE_free( b_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_stfsm_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_stfsm_work", info );
}
return info;
}
lapack_int LAPACKE_sggsvd_work( int matrix_order, char jobu, char jobv,
char jobq, lapack_int m, lapack_int n,
lapack_int p, lapack_int* k, lapack_int* l,
float* a, lapack_int lda, float* b,
lapack_int ldb, float* alpha, float* beta,
float* u, lapack_int ldu, float* v,
lapack_int ldv, float* q, lapack_int ldq,
float* work, lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sggsvd( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda, b, &ldb,
alpha, beta, u, &ldu, v, &ldv, q, &ldq, work, iwork,
&info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,m);
lapack_int ldb_t = MAX(1,p);
lapack_int ldq_t = MAX(1,n);
lapack_int ldu_t = MAX(1,m);
lapack_int ldv_t = MAX(1,p);
float* a_t = NULL;
float* b_t = NULL;
float* u_t = NULL;
float* v_t = NULL;
float* q_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
return info;
}
if( ldb < n ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
return info;
}
if( ldq < n ) {
info = -21;
LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
return info;
}
if( ldu < m ) {
info = -17;
LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
return info;
}
if( ldv < p ) {
info = -19;
LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
if( LAPACKE_lsame( jobu, 'u' ) ) {
u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) );
if( u_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
if( LAPACKE_lsame( jobv, 'v' ) ) {
v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,p) );
if( v_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_3;
}
}
if( LAPACKE_lsame( jobq, 'q' ) ) {
q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) );
if( q_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_4;
}
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_sggsvd( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, b_t,
&ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, q_t,
&ldq_t, work, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
if( LAPACKE_lsame( jobu, 'u' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu );
}
if( LAPACKE_lsame( jobv, 'v' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv );
}
if( LAPACKE_lsame( jobq, 'q' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
}
/* Release memory and exit */
if( LAPACKE_lsame( jobq, 'q' ) ) {
LAPACKE_free( q_t );
}
exit_level_4:
if( LAPACKE_lsame( jobv, 'v' ) ) {
LAPACKE_free( v_t );
}
exit_level_3:
if( LAPACKE_lsame( jobu, 'u' ) ) {
LAPACKE_free( u_t );
}
exit_level_2:
LAPACKE_free( b_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sggsvd_work", info );
}
return info;
}
lapack_int LAPACKE_cgerfsx_work( int matrix_order, char trans, char equed,
lapack_int n, lapack_int nrhs,
const lapack_complex_float* a, lapack_int lda,
const lapack_complex_float* af,
lapack_int ldaf, const lapack_int* ipiv,
const float* r, const float* c,
const lapack_complex_float* b, lapack_int ldb,
lapack_complex_float* x, lapack_int ldx,
float* rcond, float* berr,
lapack_int n_err_bnds, float* err_bnds_norm,
float* err_bnds_comp, lapack_int nparams,
float* params, lapack_complex_float* work,
float* rwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_cgerfsx( &trans, &equed, &n, &nrhs, a, &lda, af, &ldaf, ipiv, r,
c, b, &ldb, x, &ldx, rcond, berr, &n_err_bnds,
err_bnds_norm, err_bnds_comp, &nparams, params, work,
rwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
lapack_int ldaf_t = MAX(1,n);
lapack_int ldb_t = MAX(1,n);
lapack_int ldx_t = MAX(1,n);
lapack_complex_float* a_t = NULL;
lapack_complex_float* af_t = NULL;
lapack_complex_float* b_t = NULL;
lapack_complex_float* x_t = NULL;
float* err_bnds_norm_t = NULL;
float* err_bnds_comp_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info );
return info;
}
if( ldaf < n ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info );
return info;
}
if( ldb < nrhs ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info );
return info;
}
if( ldx < nrhs ) {
info = -16;
LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
af_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * ldaf_t * MAX(1,n) );
if( af_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
b_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
ldb_t * MAX(1,nrhs) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
x_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
ldx_t * MAX(1,nrhs) );
if( x_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_3;
}
err_bnds_norm_t = (float*)
LAPACKE_malloc( sizeof(float) * nrhs * MAX(1,n_err_bnds) );
if( err_bnds_norm_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_4;
}
err_bnds_comp_t = (float*)
LAPACKE_malloc( sizeof(float) * nrhs * MAX(1,n_err_bnds) );
if( err_bnds_comp_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_5;
}
/* Transpose input matrices */
LAPACKE_cge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
LAPACKE_cge_trans( matrix_order, n, n, af, ldaf, af_t, ldaf_t );
LAPACKE_cge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
LAPACKE_cge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
/* Call LAPACK function and adjust info */
LAPACK_cgerfsx( &trans, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, berr,
&n_err_bnds, err_bnds_norm_t, err_bnds_comp_t, &nparams,
params, work, rwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t,
nrhs, err_bnds_norm, nrhs );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t,
nrhs, err_bnds_comp, nrhs );
/* Release memory and exit */
LAPACKE_free( err_bnds_comp_t );
exit_level_5:
LAPACKE_free( err_bnds_norm_t );
exit_level_4:
LAPACKE_free( x_t );
exit_level_3:
LAPACKE_free( b_t );
exit_level_2:
LAPACKE_free( af_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info );
}
return info;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int kd, kd_i;
lapack_int ldab, ldab_i;
lapack_int ldab_r;
float anorm, anorm_i;
float rcond, rcond_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *ab = NULL, *ab_i = NULL;
float *work = NULL, *work_i = NULL;
lapack_int *iwork = NULL, *iwork_i = NULL;
float *ab_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_spbcon( &uplo, &n, &kd, &ldab, &anorm );
ldab_r = n+2;
uplo_i = uplo;
n_i = n;
kd_i = kd;
ldab_i = ldab;
anorm_i = anorm;
/* Allocate memory for the LAPACK routine arrays */
ab = (float *)LAPACKE_malloc( ldab*n * sizeof(float) );
work = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the C interface function arrays */
ab_i = (float *)LAPACKE_malloc( ldab*n * sizeof(float) );
work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the row-major arrays */
ab_r = (float *)LAPACKE_malloc( (kd+1)*(n+2) * sizeof(float) );
/* Initialize input arrays */
init_ab( ldab*n, ab );
init_work( 3*n, work );
init_iwork( n, iwork );
/* Call the LAPACK routine */
spbcon_( &uplo, &n, &kd, ab, &ldab, &anorm, &rcond, work, iwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_spbcon_work( LAPACK_COL_MAJOR, uplo_i, n_i, kd_i, ab_i,
ldab_i, anorm_i, &rcond_i, work_i, iwork_i );
failed = compare_spbcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to spbcon\n" );
} else {
printf( "FAILED: column-major middle-level interface to spbcon\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_spbcon( LAPACK_COL_MAJOR, uplo_i, n_i, kd_i, ab_i, ldab_i,
anorm_i, &rcond_i );
failed = compare_spbcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to spbcon\n" );
} else {
printf( "FAILED: column-major high-level interface to spbcon\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 );
info_i = LAPACKE_spbcon_work( LAPACK_ROW_MAJOR, uplo_i, n_i, kd_i, ab_r,
ldab_r, anorm_i, &rcond_i, work_i, iwork_i );
failed = compare_spbcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to spbcon\n" );
} else {
printf( "FAILED: row-major middle-level interface to spbcon\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 );
info_i = LAPACKE_spbcon( LAPACK_ROW_MAJOR, uplo_i, n_i, kd_i, ab_r, ldab_r,
anorm_i, &rcond_i );
failed = compare_spbcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to spbcon\n" );
} else {
printf( "FAILED: row-major high-level interface to spbcon\n" );
}
/* Release memory */
if( ab != NULL ) {
LAPACKE_free( ab );
}
if( ab_i != NULL ) {
LAPACKE_free( ab_i );
}
if( ab_r != NULL ) {
LAPACKE_free( ab_r );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( iwork != NULL ) {
LAPACKE_free( iwork );
}
if( iwork_i != NULL ) {
LAPACKE_free( iwork_i );
}
return 0;
}
lapack_int LAPACKE_ssygvx_work( int matrix_layout, lapack_int itype, char jobz,
char range, char uplo, lapack_int n, float* a,
lapack_int lda, float* b, lapack_int ldb,
float vl, float vu, lapack_int il,
lapack_int iu, float abstol, lapack_int* m,
float* w, float* z, lapack_int ldz, float* work,
lapack_int lwork, lapack_int* iwork,
lapack_int* ifail )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a, &lda, b, &ldb, &vl,
&vu, &il, &iu, &abstol, m, w, z, &ldz, work, &lwork,
iwork, ifail, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) ||
LAPACKE_lsame( range, 'v' ) ) ? n :
( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1);
lapack_int lda_t = MAX(1,n);
lapack_int ldb_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
float* a_t = NULL;
float* b_t = NULL;
float* z_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
return info;
}
if( ldb < n ) {
info = -10;
LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
return info;
}
if( ldz < ncols_z ) {
info = -19;
LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a, &lda_t, b,
&ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz_t,
work, &lwork, iwork, ifail, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
if( LAPACKE_lsame( jobz, 'v' ) ) {
z_t = (float*)
LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) );
if( z_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
/* Transpose input matrices */
LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a_t, &lda_t, b_t,
&ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t,
work, &lwork, iwork, ifail, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z,
ldz );
}
/* Release memory and exit */
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_free( z_t );
}
exit_level_2:
LAPACKE_free( b_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_ssygvx_work", info );
}
return info;
}
lapack_int LAPACKE_sggev_work( int matrix_order, char jobvl, char jobvr,
lapack_int n, float* a, lapack_int lda, float* b,
lapack_int ldb, float* alphar, float* alphai,
float* beta, float* vl, lapack_int ldvl,
float* vr, lapack_int ldvr, float* work,
lapack_int lwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sggev( &jobvl, &jobvr, &n, a, &lda, b, &ldb, alphar, alphai,
beta, vl, &ldvl, vr, &ldvr, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1;
lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1;
lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1;
lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1;
lapack_int lda_t = MAX(1,n);
lapack_int ldb_t = MAX(1,n);
lapack_int ldvl_t = MAX(1,nrows_vl);
lapack_int ldvr_t = MAX(1,nrows_vr);
float* a_t = NULL;
float* b_t = NULL;
float* vl_t = NULL;
float* vr_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_sggev_work", info );
return info;
}
if( ldb < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_sggev_work", info );
return info;
}
if( ldvl < ncols_vl ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_sggev_work", info );
return info;
}
if( ldvr < ncols_vr ) {
info = -15;
LAPACKE_xerbla( "LAPACKE_sggev_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_sggev( &jobvl, &jobvr, &n, a, &lda_t, b, &ldb_t, alphar,
alphai, beta, vl, &ldvl_t, vr, &ldvr_t, work, &lwork,
&info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
if( LAPACKE_lsame( jobvl, 'v' ) ) {
vl_t = (float*)
LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,ncols_vl) );
if( vl_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
if( LAPACKE_lsame( jobvr, 'v' ) ) {
vr_t = (float*)
LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,ncols_vr) );
if( vr_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_3;
}
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_sggev( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alphar,
alphai, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, work, &lwork,
&info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
if( LAPACKE_lsame( jobvl, 'v' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t,
ldvl_t, vl, ldvl );
}
if( LAPACKE_lsame( jobvr, 'v' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t,
ldvr_t, vr, ldvr );
}
/* Release memory and exit */
if( LAPACKE_lsame( jobvr, 'v' ) ) {
LAPACKE_free( vr_t );
}
exit_level_3:
if( LAPACKE_lsame( jobvl, 'v' ) ) {
LAPACKE_free( vl_t );
}
exit_level_2:
LAPACKE_free( b_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sggev_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sggev_work", info );
}
return info;
}
void LAPACKE_sgg_trans( int matrix_order, lapack_int m, lapack_int n,
const float* in, lapack_int ldin,
float* out, lapack_int ldout )
{
LAPACKE_sge_trans( matrix_order, m, n, in, ldin, out, ldout );
}