lapack_int LAPACKE_cgemqrt_work( int matrix_order, char side, char trans,
lapack_int m, lapack_int n, lapack_int k,
lapack_int nb, const lapack_complex_float* v,
lapack_int ldv, const lapack_complex_float* t,
lapack_int ldt, lapack_complex_float* c,
lapack_int ldc, lapack_complex_float* work )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_cgemqrt( &side, &trans, &m, &n, &k, &nb, v, &ldv, t, &ldt, c,
&ldc, work, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldc_t = MAX(1,m);
lapack_int ldt_t = MAX(1,ldt);
lapack_int ldv_t = MAX(1,ldv);
lapack_complex_float* v_t = NULL;
lapack_complex_float* t_t = NULL;
lapack_complex_float* c_t = NULL;
/* Check leading dimension(s) */
if( ldc < n ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info );
return info;
}
if( ldt < nb ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info );
return info;
}
if( ldv < k ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
v_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,k) );
if( v_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
t_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * ldt_t * MAX(1,nb) );
if( t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
c_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * ldc_t * MAX(1,n) );
if( c_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
/* Transpose input matrices */
LAPACKE_cge_trans( matrix_order, ldv, k, v, ldv, v_t, ldv_t );
LAPACKE_cge_trans( matrix_order, ldt, nb, t, ldt, t_t, ldt_t );
LAPACKE_cge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */
LAPACK_cgemqrt( &side, &trans, &m, &n, &k, &nb, v_t, &ldv_t, t_t,
&ldt_t, c_t, &ldc_t, work, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
/* Release memory and exit */
LAPACKE_free( c_t );
exit_level_2:
LAPACKE_free( t_t );
exit_level_1:
LAPACKE_free( v_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_cgemqrt_work", info );
}
return info;
}
lapack_int LAPACKE_chesvxx( 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,
lapack_int* ipiv, 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_int info = 0;
float* rwork = NULL;
lapack_complex_float* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_chesvxx", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
return -6;
}
if( LAPACKE_lsame( fact, 'f' ) ) {
if( LAPACKE_che_nancheck( matrix_layout, uplo, n, af, ldaf ) ) {
return -8;
}
}
if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) {
return -13;
}
if( nparams>0 ) {
if( LAPACKE_s_nancheck( nparams, params, 1 ) ) {
return -24;
}
}
if( LAPACKE_lsame( fact, 'f' ) ) {
if( LAPACKE_s_nancheck( n, s, 1 ) ) {
return -12;
}
}
#endif
/* Allocate memory for working array(s) */
rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) );
if( rwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * MAX(1,2*n) );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Call middle-level interface */
info = LAPACKE_chesvxx_work( matrix_layout, fact, uplo, n, nrhs, a, lda, af,
ldaf, ipiv, equed, s, b, ldb, x, ldx, rcond,
rpvgrw, berr, n_err_bnds, err_bnds_norm,
err_bnds_comp, nparams, params, work, rwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_1:
LAPACKE_free( rwork );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_chesvxx", info );
}
return info;
}
lapack_int LAPACKE_csysv_work( int matrix_order, char uplo, lapack_int n,
lapack_int nrhs, lapack_complex_float* a,
lapack_int lda, lapack_int* ipiv,
lapack_complex_float* b, lapack_int ldb,
lapack_complex_float* work, lapack_int lwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_csysv( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, work, &lwork,
&info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
lapack_int ldb_t = MAX(1,n);
lapack_complex_float* a_t = NULL;
lapack_complex_float* b_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_csysv_work", info );
return info;
}
if( ldb < nrhs ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_csysv_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_csysv( &uplo, &n, &nrhs, a, &lda_t, ipiv, b, &ldb_t, work,
&lwork, &info );
return (info < 0) ? (info - 1) : 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;
}
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_1;
}
/* Transpose input matrices */
LAPACKE_csy_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
LAPACKE_cge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_csysv( &uplo, &n, &nrhs, a_t, &lda_t, ipiv, b_t, &ldb_t, work,
&lwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
LAPACKE_cge_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( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_csysv_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_csysv_work", info );
}
return info;
}
lapack_int LAPACKE_dgeevx_work( int matrix_layout, char balanc, char jobvl,
char jobvr, char sense, lapack_int n, double* a,
lapack_int lda, double* wr, double* wi,
double* vl, lapack_int ldvl, double* vr,
lapack_int ldvr, lapack_int* ilo,
lapack_int* ihi, double* scale, double* abnrm,
double* rconde, double* rcondv, double* work,
lapack_int lwork, lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_dgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda, wr, wi, vl,
&ldvl, vr, &ldvr, ilo, ihi, scale, abnrm, rconde, rcondv,
work, &lwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
lapack_int ldvl_t = MAX(1,n);
lapack_int ldvr_t = MAX(1,n);
double* a_t = NULL;
double* vl_t = NULL;
double* vr_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
return info;
}
if( ldvl < n ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
return info;
}
if( ldvr < n ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_dgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a, &lda_t, wr,
wi, vl, &ldvl_t, vr, &ldvr_t, ilo, ihi, scale, abnrm,
rconde, rcondv, work, &lwork, iwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
if( LAPACKE_lsame( jobvl, 'v' ) ) {
vl_t = (double*)
LAPACKE_malloc( sizeof(double) * ldvl_t * MAX(1,n) );
if( vl_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
}
if( LAPACKE_lsame( jobvr, 'v' ) ) {
vr_t = (double*)
LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,n) );
if( vr_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
/* Transpose input matrices */
LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_dgeevx( &balanc, &jobvl, &jobvr, &sense, &n, a_t, &lda_t, wr, wi,
vl_t, &ldvl_t, vr_t, &ldvr_t, ilo, ihi, scale, abnrm,
rconde, rcondv, work, &lwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
if( LAPACKE_lsame( jobvl, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vl_t, ldvl_t, vl, ldvl );
}
if( LAPACKE_lsame( jobvr, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vr_t, ldvr_t, vr, ldvr );
}
/* Release memory and exit */
if( LAPACKE_lsame( jobvr, 'v' ) ) {
LAPACKE_free( vr_t );
}
exit_level_2:
if( LAPACKE_lsame( jobvl, 'v' ) ) {
LAPACKE_free( vl_t );
}
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_dgeevx_work", info );
}
return info;
}
lapack_int LAPACKE_zhesvxx_work( int matrix_layout, char fact, char uplo,
lapack_int n, lapack_int nrhs,
lapack_complex_double* a, lapack_int lda,
lapack_complex_double* af, lapack_int ldaf,
lapack_int* ipiv, char* equed, double* s,
lapack_complex_double* b, lapack_int ldb,
lapack_complex_double* x, lapack_int ldx,
double* rcond, double* rpvgrw, double* berr,
lapack_int n_err_bnds, double* err_bnds_norm,
double* err_bnds_comp, lapack_int nparams,
double* params, lapack_complex_double* work,
double* rwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zhesvxx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, ipiv,
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_double* a_t = NULL;
lapack_complex_double* af_t = NULL;
lapack_complex_double* b_t = NULL;
lapack_complex_double* x_t = NULL;
double* err_bnds_norm_t = NULL;
double* err_bnds_comp_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info );
return info;
}
if( ldaf < n ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info );
return info;
}
if( ldb < nrhs ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info );
return info;
}
if( ldx < nrhs ) {
info = -16;
LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
a_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
af_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldaf_t * MAX(1,n) );
if( af_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
b_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldb_t * MAX(1,nrhs) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
x_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldx_t * MAX(1,nrhs) );
if( x_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_3;
}
err_bnds_norm_t = (double*)
LAPACKE_malloc( sizeof(double) * 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 = (double*)
LAPACKE_malloc( sizeof(double) * 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_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
if( LAPACKE_lsame( fact, 'f' ) ) {
LAPACKE_zhe_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t );
}
LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_zhesvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
ipiv, 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_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
}
if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af,
ldaf );
}
if( LAPACKE_lsame( fact, 'f' ) && LAPACKE_lsame( *equed, 'y' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t,
nrhs, err_bnds_norm, n_err_bnds );
LAPACKE_dge_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_zhesvxx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zhesvxx_work", info );
}
return info;
}
lapack_int LAPACKE_zgtrfs( int matrix_order, char trans, lapack_int n,
lapack_int nrhs, const lapack_complex_double* dl,
const lapack_complex_double* d,
const lapack_complex_double* du,
const lapack_complex_double* dlf,
const lapack_complex_double* df,
const lapack_complex_double* duf,
const lapack_complex_double* du2,
const lapack_int* ipiv,
const lapack_complex_double* b, lapack_int ldb,
lapack_complex_double* x, lapack_int ldx,
double* ferr, double* berr )
{
lapack_int info = 0;
double* rwork = NULL;
lapack_complex_double* work = NULL;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zgtrfs", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_zge_nancheck( matrix_order, n, nrhs, b, ldb ) ) {
return -13;
}
if( LAPACKE_z_nancheck( n, d, 1 ) ) {
return -6;
}
if( LAPACKE_z_nancheck( n, df, 1 ) ) {
return -9;
}
if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) {
return -5;
}
if( LAPACKE_z_nancheck( n-1, dlf, 1 ) ) {
return -8;
}
if( LAPACKE_z_nancheck( n-1, du, 1 ) ) {
return -7;
}
if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) {
return -11;
}
if( LAPACKE_z_nancheck( n-1, duf, 1 ) ) {
return -10;
}
if( LAPACKE_zge_nancheck( matrix_order, n, nrhs, x, ldx ) ) {
return -15;
}
#endif
/* Allocate memory for working array(s) */
rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
if( rwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
work = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * MAX(1,2*n) );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Call middle-level interface */
info = LAPACKE_zgtrfs_work( matrix_order, trans, n, nrhs, dl, d, du, dlf,
df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr,
work, rwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_1:
LAPACKE_free( rwork );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zgtrfs", info );
}
return info;
}
lapack_int LAPACKE_zgghd3( int matrix_layout, char compq, char compz,
lapack_int n, lapack_int ilo, lapack_int ihi,
lapack_complex_double* a, lapack_int lda,
lapack_complex_double* b, lapack_int ldb,
lapack_complex_double* q, lapack_int ldq,
lapack_complex_double* z, lapack_int ldz )
{
lapack_int info = 0;
lapack_int lwork = -1;
lapack_complex_double* work = NULL;
lapack_complex_double work_query;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zgghd3", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
return -7;
}
if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
return -9;
}
if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
if( LAPACKE_zge_nancheck( matrix_layout, n, n, q, ldq ) ) {
return -11;
}
}
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
if( LAPACKE_zge_nancheck( matrix_layout, n, n, z, ldz ) ) {
return -13;
}
}
#endif
/* Query optimal working array(s) size */
info = LAPACKE_zgghd3_work( matrix_layout, compq, compz, n, ilo, ihi,
a, lda, b, ldb, q, ldq, z, ldz, &work_query,
lwork );
if( info != 0 ) {
goto exit_level_0;
}
lwork = LAPACK_C2INT( work_query );
/* Allocate memory for work arrays */
work = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Call middle-level interface */
info = LAPACKE_zgghd3_work( matrix_layout, compq, compz, n, ilo, ihi,
a, lda, b, ldb, q, ldq, z, ldz, work,
lwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zgghd3", info );
}
return info;
}
lapack_int LAPACKE_cgelsd( int matrix_order, lapack_int m, lapack_int n,
lapack_int nrhs, lapack_complex_float* a,
lapack_int lda, lapack_complex_float* b,
lapack_int ldb, float* s, float rcond,
lapack_int* rank )
{
lapack_int info = 0;
lapack_int lwork = -1;
/* Additional scalars declarations for work arrays */
lapack_int liwork;
lapack_int lrwork;
lapack_int* iwork = NULL;
float* rwork = NULL;
lapack_complex_float* work = NULL;
lapack_int iwork_query;
float rwork_query;
lapack_complex_float work_query;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cgelsd", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_cge_nancheck( matrix_order, m, n, a, lda ) ) {
return -5;
}
if( LAPACKE_cge_nancheck( matrix_order, MAX(m,n), nrhs, b, ldb ) ) {
return -7;
}
if( LAPACKE_s_nancheck( 1, &rcond, 1 ) ) {
return -10;
}
#endif
/* Query optimal working array(s) size */
info = LAPACKE_cgelsd_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
rcond, rank, &work_query, lwork, &rwork_query,
&iwork_query );
if( info != 0 ) {
goto exit_level_0;
}
liwork = (lapack_int)iwork_query;
lrwork = (lapack_int)rwork_query;
lwork = LAPACK_C2INT( work_query );
/* Allocate memory for work arrays */
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
if( iwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork );
if( rwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_2;
}
/* Call middle-level interface */
info = LAPACKE_cgelsd_work( matrix_order, m, n, nrhs, a, lda, b, ldb, s,
rcond, rank, work, lwork, rwork, iwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_2:
LAPACKE_free( rwork );
exit_level_1:
LAPACKE_free( iwork );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cgelsd", info );
}
return info;
}
lapack_int LAPACKE_clacpy_work( int matrix_order, char uplo, lapack_int m,
lapack_int n, const lapack_complex_float* a,
lapack_int lda, lapack_complex_float* b,
lapack_int ldb )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_clacpy( &uplo, &m, &n, a, &lda, b, &ldb );
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,m);
lapack_complex_float* a_t = NULL;
lapack_complex_float* b_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_clacpy_work", info );
return info;
}
if( ldb < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_clacpy_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;
}
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_cge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_clacpy( &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_clacpy_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_clacpy_work", info );
}
return info;
}
lapack_int LAPACKE_dpprfs_work( int matrix_layout, char uplo, lapack_int n,
lapack_int nrhs, const double* ap,
const double* afp, const double* b,
lapack_int ldb, double* x, lapack_int ldx,
double* ferr, double* berr, double* work,
lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_dpprfs( &uplo, &n, &nrhs, ap, afp, b, &ldb, x, &ldx, ferr, berr,
work, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldb_t = MAX(1,n);
lapack_int ldx_t = MAX(1,n);
double* b_t = NULL;
double* x_t = NULL;
double* ap_t = NULL;
double* afp_t = NULL;
/* Check leading dimension(s) */
if( ldb < nrhs ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_dpprfs_work", info );
return info;
}
if( ldx < nrhs ) {
info = -10;
LAPACKE_xerbla( "LAPACKE_dpprfs_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) );
if( x_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
ap_t = (double*)
LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
if( ap_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
afp_t = (double*)
LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
if( afp_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_3;
}
/* Transpose input matrices */
LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t );
LAPACKE_dpp_trans( matrix_layout, uplo, n, ap, ap_t );
LAPACKE_dpp_trans( matrix_layout, uplo, n, afp, afp_t );
/* Call LAPACK function and adjust info */
LAPACK_dpprfs( &uplo, &n, &nrhs, ap_t, afp_t, b_t, &ldb_t, x_t, &ldx_t,
ferr, berr, work, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
/* Release memory and exit */
LAPACKE_free( afp_t );
exit_level_3:
LAPACKE_free( ap_t );
exit_level_2:
LAPACKE_free( x_t );
exit_level_1:
LAPACKE_free( b_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_dpprfs_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_dpprfs_work", info );
}
return info;
}
lapack_int LAPACKE_strsen( int matrix_order, char job, char compq,
const lapack_logical* select, lapack_int n, float* t,
lapack_int ldt, float* q, lapack_int ldq, float* wr,
float* wi, lapack_int* m, float* s, float* sep )
{
lapack_int info = 0;
lapack_int liwork = -1;
lapack_int lwork = -1;
lapack_int* iwork = NULL;
float* work = NULL;
lapack_int iwork_query;
float work_query;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_strsen", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_lsame( compq, 'v' ) ) {
if( LAPACKE_sge_nancheck( matrix_order, n, n, q, ldq ) ) {
return -8;
}
}
if( LAPACKE_sge_nancheck( matrix_order, n, n, t, ldt ) ) {
return -6;
}
#endif
/* Query optimal working array(s) size */
info = LAPACKE_strsen_work( matrix_order, job, compq, select, n, t, ldt, q,
ldq, wr, wi, m, s, sep, &work_query, lwork,
&iwork_query, liwork );
if( info != 0 ) {
goto exit_level_0;
}
liwork = (lapack_int)iwork_query;
lwork = (lapack_int)work_query;
/* Allocate memory for work arrays */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
if( iwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
}
work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Call middle-level interface */
info = LAPACKE_strsen_work( matrix_order, job, compq, select, n, t, ldt, q,
ldq, wr, wi, m, s, sep, work, lwork, iwork,
liwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_1:
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
LAPACKE_free( iwork );
}
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_strsen", info );
}
return info;
}
lapack_int LAPACKE_sgbrfsx_work( int matrix_order, char trans, char equed,
lapack_int n, lapack_int kl, lapack_int ku,
lapack_int nrhs, const float* ab,
lapack_int ldab, const float* afb,
lapack_int ldafb, const lapack_int* ipiv,
const float* r, const float* c, const float* b,
lapack_int ldb, 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, float* work, lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sgbrfsx( &trans, &equed, &n, &kl, &ku, &nrhs, ab, &ldab, afb,
&ldafb, ipiv, r, c, b, &ldb, x, &ldx, rcond, berr,
&n_err_bnds, err_bnds_norm, err_bnds_comp, &nparams,
params, work, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldab_t = MAX(1,kl+ku+1);
lapack_int ldafb_t = MAX(1,2*kl+ku+1);
lapack_int ldb_t = MAX(1,n);
lapack_int ldx_t = MAX(1,n);
float* ab_t = NULL;
float* afb_t = NULL;
float* b_t = NULL;
float* x_t = NULL;
float* err_bnds_norm_t = NULL;
float* err_bnds_comp_t = NULL;
/* Check leading dimension(s) */
if( ldab < n ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info );
return info;
}
if( ldafb < n ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info );
return info;
}
if( ldb < nrhs ) {
info = -16;
LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info );
return info;
}
if( ldx < nrhs ) {
info = -18;
LAPACKE_xerbla( "LAPACKE_sgbrfsx_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;
}
afb_t = (float*)LAPACKE_malloc( sizeof(float) * ldafb_t * MAX(1,n) );
if( afb_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
x_t = (float*)LAPACKE_malloc( sizeof(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_sgb_trans( matrix_order, n, n, kl, ku, ab, ldab, ab_t, ldab_t );
LAPACKE_sgb_trans( matrix_order, n, n, kl, kl+ku, afb, ldafb, afb_t,
ldafb_t );
LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
/* Call LAPACK function and adjust info */
LAPACK_sgbrfsx( &trans, &equed, &n, &kl, &ku, &nrhs, ab_t, &ldab_t,
afb_t, &ldafb_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, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_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( afb_t );
exit_level_1:
LAPACKE_free( ab_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sgbrfsx_work", info );
}
return info;
}
lapack_int LAPACKE_cggesx( int matrix_layout, char jobvsl, char jobvsr,
char sort, LAPACK_C_SELECT2 selctg, char sense,
lapack_int n, lapack_complex_float* a,
lapack_int lda, lapack_complex_float* b,
lapack_int ldb, lapack_int* sdim,
lapack_complex_float* alpha,
lapack_complex_float* beta,
lapack_complex_float* vsl, lapack_int ldvsl,
lapack_complex_float* vsr, lapack_int ldvsr,
float* rconde, float* rcondv )
{
lapack_int info = 0;
lapack_int liwork = -1;
lapack_int lwork = -1;
lapack_logical* bwork = NULL;
lapack_int* iwork = NULL;
float* rwork = NULL;
lapack_complex_float* work = NULL;
lapack_int iwork_query;
lapack_complex_float work_query;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cggesx", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) {
return -8;
}
if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
return -10;
}
#endif
/* Allocate memory for working array(s) */
if( LAPACKE_lsame( sort, 's' ) ) {
bwork = (lapack_logical*)
LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
if( bwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
}
rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,8*n) );
if( rwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Query optimal working array(s) size */
info = LAPACKE_cggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg,
sense, n, a, lda, b, ldb, sdim, alpha, beta,
vsl, ldvsl, vsr, ldvsr, rconde, rcondv,
&work_query, lwork, rwork, &iwork_query, liwork,
bwork );
if( info != 0 ) {
goto exit_level_2;
}
liwork = (lapack_int)iwork_query;
lwork = LAPACK_C2INT( work_query );
/* Allocate memory for work arrays */
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
if( iwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_2;
}
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_3;
}
/* Call middle-level interface */
info = LAPACKE_cggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg,
sense, n, a, lda, b, ldb, sdim, alpha, beta,
vsl, ldvsl, vsr, ldvsr, rconde, rcondv, work,
lwork, rwork, iwork, liwork, bwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_3:
LAPACKE_free( iwork );
exit_level_2:
LAPACKE_free( rwork );
exit_level_1:
if( LAPACKE_lsame( sort, 's' ) ) {
LAPACKE_free( bwork );
}
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cggesx", info );
}
return info;
}
lapack_int LAPACKE_stgsyl( int matrix_layout, char trans, lapack_int ijob,
lapack_int m, lapack_int n, const float* a,
lapack_int lda, const float* b, lapack_int ldb,
float* c, lapack_int ldc, const float* d,
lapack_int ldd, const float* e, lapack_int lde,
float* f, lapack_int ldf, float* scale, float* dif )
{
lapack_int info = 0;
lapack_int lwork = -1;
lapack_int* iwork = NULL;
float* work = NULL;
float work_query;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_stgsyl", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_sge_nancheck( matrix_layout, m, m, a, lda ) ) {
return -6;
}
if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
return -8;
}
if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
return -10;
}
if( LAPACKE_sge_nancheck( matrix_layout, m, m, d, ldd ) ) {
return -12;
}
if( LAPACKE_sge_nancheck( matrix_layout, n, n, e, lde ) ) {
return -14;
}
if( LAPACKE_sge_nancheck( matrix_layout, m, n, f, ldf ) ) {
return -16;
}
#endif
/* Allocate memory for working array(s) */
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m+n+6) );
if( iwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Query optimal working array(s) size */
info = LAPACKE_stgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb,
c, ldc, d, ldd, e, lde, f, ldf, scale, dif,
&work_query, lwork, iwork );
if( info != 0 ) {
goto exit_level_1;
}
lwork = (lapack_int)work_query;
/* Allocate memory for work arrays */
work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Call middle-level interface */
info = LAPACKE_stgsyl_work( matrix_layout, trans, ijob, m, n, a, lda, b, ldb,
c, ldc, d, ldd, e, lde, f, ldf, scale, dif,
work, lwork, iwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_1:
LAPACKE_free( iwork );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_stgsyl", info );
}
return info;
}
lapack_int LAPACKE_cggevx( int matrix_order, char balanc, char jobvl,
char jobvr, char sense, lapack_int n,
lapack_complex_float* a, lapack_int lda,
lapack_complex_float* b, lapack_int ldb,
lapack_complex_float* alpha,
lapack_complex_float* beta, lapack_complex_float* vl,
lapack_int ldvl, lapack_complex_float* vr,
lapack_int ldvr, lapack_int* ilo, lapack_int* ihi,
float* lscale, float* rscale, float* abnrm,
float* bbnrm, float* rconde, float* rcondv )
{
lapack_int info = 0;
lapack_int lwork = -1;
/* Additional scalars declarations for work arrays */
lapack_int lrwork;
lapack_logical* bwork = NULL;
lapack_int* iwork = NULL;
float* rwork = NULL;
lapack_complex_float* work = NULL;
lapack_complex_float work_query;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cggevx", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_cge_nancheck( matrix_order, n, n, a, lda ) ) {
return -7;
}
if( LAPACKE_cge_nancheck( matrix_order, n, n, b, ldb ) ) {
return -9;
}
#endif
/* Additional scalars initializations for work arrays */
if( LAPACKE_lsame( balanc, 's' ) || LAPACKE_lsame( balanc, 'b' ) ) {
lrwork = MAX(1,6*n);
} else {
lrwork = MAX(1,2*n);
}
/* Allocate memory for working array(s) */
if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) ||
LAPACKE_lsame( sense, 'v' ) ) {
bwork = (lapack_logical*)
LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
if( bwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
}
if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) ||
LAPACKE_lsame( sense, 'v' ) ) {
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+2) );
if( iwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
}
rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork );
if( rwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_2;
}
/* Query optimal working array(s) size */
info = LAPACKE_cggevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr,
ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde,
rcondv, &work_query, lwork, rwork, iwork,
bwork );
if( info != 0 ) {
goto exit_level_3;
}
lwork = LAPACK_C2INT( work_query );
/* Allocate memory for work arrays */
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_3;
}
/* Call middle-level interface */
info = LAPACKE_cggevx_work( matrix_order, balanc, jobvl, jobvr, sense, n, a,
lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr,
ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde,
rcondv, work, lwork, rwork, iwork, bwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_3:
LAPACKE_free( rwork );
exit_level_2:
if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'n' ) ||
LAPACKE_lsame( sense, 'v' ) ) {
LAPACKE_free( iwork );
}
exit_level_1:
if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'e' ) ||
LAPACKE_lsame( sense, 'v' ) ) {
LAPACKE_free( bwork );
}
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cggevx", info );
}
return info;
}
lapack_int LAPACKE_cstedc_work( int matrix_layout, char compz, lapack_int n,
float* d, float* e, lapack_complex_float* z,
lapack_int ldz, lapack_complex_float* work,
lapack_int lwork, float* rwork,
lapack_int lrwork, lapack_int* iwork,
lapack_int liwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_cstedc( &compz, &n, d, e, z, &ldz, work, &lwork, rwork, &lrwork,
iwork, &liwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldz_t = MAX(1,n);
lapack_complex_float* z_t = NULL;
/* Check leading dimension(s) */
if( ldz < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_cstedc_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( liwork == -1 || lrwork == -1 || lwork == -1 ) {
LAPACK_cstedc( &compz, &n, d, e, z, &ldz_t, work, &lwork, rwork,
&lrwork, iwork, &liwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
z_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_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_cge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t );
}
/* Call LAPACK function and adjust info */
LAPACK_cstedc( &compz, &n, d, e, z_t, &ldz_t, work, &lwork, rwork,
&lrwork, iwork, &liwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
}
/* Release memory and exit */
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_free( z_t );
}
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cstedc_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_cstedc_work", info );
}
return info;
}
lapack_int LAPACKE_zunmtr_work( int matrix_order, char side, char uplo,
char trans, lapack_int m, lapack_int n,
const lapack_complex_double* a, lapack_int lda,
const lapack_complex_double* tau,
lapack_complex_double* c, lapack_int ldc,
lapack_complex_double* work, lapack_int lwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zunmtr( &side, &uplo, &trans, &m, &n, a, &lda, tau, c, &ldc,
work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
lapack_int lda_t = MAX(1,r);
lapack_int ldc_t = MAX(1,m);
lapack_complex_double* a_t = NULL;
lapack_complex_double* c_t = NULL;
/* Check leading dimension(s) */
if( lda < r ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_zunmtr_work", info );
return info;
}
if( ldc < n ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_zunmtr_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_zunmtr( &side, &uplo, &trans, &m, &n, a, &lda_t, tau, c,
&ldc_t, work, &lwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
a_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,r) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
c_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldc_t * MAX(1,n) );
if( c_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, r, r, a, lda, a_t, lda_t );
LAPACKE_zge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */
LAPACK_zunmtr( &side, &uplo, &trans, &m, &n, a_t, &lda_t, tau, c_t,
&ldc_t, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_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_zunmtr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zunmtr_work", info );
}
return info;
}
lapack_int LAPACKE_cheevx( int matrix_layout, char jobz, char range, char uplo,
lapack_int n, lapack_complex_float* a,
lapack_int lda, float vl, float vu, lapack_int il,
lapack_int iu, float abstol, lapack_int* m, float* w,
lapack_complex_float* z, lapack_int ldz,
lapack_int* ifail )
{
lapack_int info = 0;
lapack_int lwork = -1;
lapack_int* iwork = NULL;
float* rwork = NULL;
lapack_complex_float* work = NULL;
lapack_complex_float work_query;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cheevx", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */
if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) {
return -6;
}
if( LAPACKE_s_nancheck( 1, &abstol, 1 ) ) {
return -12;
}
if( LAPACKE_lsame( range, 'v' ) ) {
if( LAPACKE_s_nancheck( 1, &vl, 1 ) ) {
return -8;
}
}
if( LAPACKE_lsame( range, 'v' ) ) {
if( LAPACKE_s_nancheck( 1, &vu, 1 ) ) {
return -9;
}
}
}
#endif
/* Allocate memory for working array(s) */
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
if( iwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,7*n) );
if( rwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Query optimal working array(s) size */
info = LAPACKE_cheevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl,
vu, il, iu, abstol, m, w, z, ldz, &work_query,
lwork, rwork, iwork, ifail );
if( info != 0 ) {
goto exit_level_2;
}
lwork = LAPACK_C2INT( work_query );
/* Allocate memory for work arrays */
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_2;
}
/* Call middle-level interface */
info = LAPACKE_cheevx_work( matrix_layout, jobz, range, uplo, n, a, lda, vl,
vu, il, iu, abstol, m, w, z, ldz, work, lwork,
rwork, iwork, ifail );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_2:
LAPACKE_free( rwork );
exit_level_1:
LAPACKE_free( iwork );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cheevx", info );
}
return info;
}
lapack_int LAPACKE_sptsvx_work( int matrix_order, char fact, lapack_int n,
lapack_int nrhs, const float* d, const float* e,
float* df, float* ef, const float* b,
lapack_int ldb, float* x, lapack_int ldx,
float* rcond, float* ferr, float* berr,
float* work )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sptsvx( &fact, &n, &nrhs, d, e, df, ef, b, &ldb, x, &ldx, rcond,
ferr, berr, work, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldb_t = MAX(1,n);
lapack_int ldx_t = MAX(1,n);
float* b_t = NULL;
float* x_t = NULL;
/* Check leading dimension(s) */
if( ldb < nrhs ) {
info = -10;
LAPACKE_xerbla( "LAPACKE_sptsvx_work", info );
return info;
}
if( ldx < nrhs ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_sptsvx_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;
}
x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
if( x_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 );
/* Call LAPACK function and adjust info */
LAPACK_sptsvx( &fact, &n, &nrhs, d, e, df, ef, b_t, &ldb_t, x_t, &ldx_t,
rcond, ferr, berr, work, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
/* Release memory and exit */
LAPACKE_free( x_t );
exit_level_1:
LAPACKE_free( b_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_sptsvx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sptsvx_work", info );
}
return info;
}
lapack_int LAPACKE_ztgsna( int matrix_order, char job, char howmny,
const lapack_logical* select, lapack_int n,
const lapack_complex_double* a, lapack_int lda,
const lapack_complex_double* b, lapack_int ldb,
const lapack_complex_double* vl, lapack_int ldvl,
const lapack_complex_double* vr, lapack_int ldvr,
double* s, double* dif, lapack_int mm,
lapack_int* m )
{
lapack_int info = 0;
lapack_int lwork = -1;
lapack_int* iwork = NULL;
lapack_complex_double* work = NULL;
lapack_complex_double work_query;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_ztgsna", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_zge_nancheck( matrix_order, n, n, a, lda ) ) {
return -6;
}
if( LAPACKE_zge_nancheck( matrix_order, n, n, b, ldb ) ) {
return -8;
}
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
if( LAPACKE_zge_nancheck( matrix_order, n, mm, vl, ldvl ) ) {
return -10;
}
}
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'e' ) ) {
if( LAPACKE_zge_nancheck( matrix_order, n, mm, vr, ldvr ) ) {
return -12;
}
}
#endif
/* Allocate memory for working array(s) */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n+2) );
if( iwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
}
/* Query optimal working array(s) size */
info = LAPACKE_ztgsna_work( matrix_order, job, howmny, select, n, a, lda, b,
ldb, vl, ldvl, vr, ldvr, s, dif, mm, m,
&work_query, lwork, iwork );
if( info != 0 ) {
goto exit_level_1;
}
lwork = LAPACK_Z2INT( work_query );
/* Allocate memory for work arrays */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
work = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
}
/* Call middle-level interface */
info = LAPACKE_ztgsna_work( matrix_order, job, howmny, select, n, a, lda, b,
ldb, vl, ldvl, vr, ldvr, s, dif, mm, m, work,
lwork, iwork );
/* Release memory and exit */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
LAPACKE_free( work );
}
exit_level_1:
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) {
LAPACKE_free( iwork );
}
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_ztgsna", info );
}
return info;
}
lapack_int LAPACKE_zheevd( int matrix_layout, char jobz, char uplo, lapack_int n,
lapack_complex_double* a, lapack_int lda, double* w )
{
lapack_int info = 0;
lapack_int liwork = -1;
lapack_int lrwork = -1;
lapack_int lwork = -1;
lapack_int* iwork = NULL;
double* rwork = NULL;
lapack_complex_double* work = NULL;
lapack_int iwork_query;
double rwork_query;
lapack_complex_double work_query;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zheevd", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */
if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) {
return -5;
}
}
#endif
/* Query optimal working array(s) size */
info = LAPACKE_zheevd_work( matrix_layout, jobz, uplo, n, a, lda, w,
&work_query, lwork, &rwork_query, lrwork,
&iwork_query, liwork );
if( info != 0 ) {
goto exit_level_0;
}
liwork = (lapack_int)iwork_query;
lrwork = (lapack_int)rwork_query;
lwork = LAPACK_Z2INT( work_query );
/* Allocate memory for work arrays */
iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
if( iwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork );
if( rwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
work = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_2;
}
/* Call middle-level interface */
info = LAPACKE_zheevd_work( matrix_layout, jobz, uplo, n, a, lda, w, work,
lwork, rwork, lrwork, iwork, liwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_2:
LAPACKE_free( rwork );
exit_level_1:
LAPACKE_free( iwork );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zheevd", info );
}
return info;
}
lapack_int LAPACKE_zhgeqz( int matrix_order, char job, char compq, char compz,
lapack_int n, lapack_int ilo, lapack_int ihi,
lapack_complex_double* h, lapack_int ldh,
lapack_complex_double* t, lapack_int ldt,
lapack_complex_double* alpha,
lapack_complex_double* beta,
lapack_complex_double* q, lapack_int ldq,
lapack_complex_double* z, lapack_int ldz )
{
lapack_int info = 0;
lapack_int lwork = -1;
double* rwork = NULL;
lapack_complex_double* work = NULL;
lapack_complex_double work_query;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zhgeqz", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_zge_nancheck( matrix_order, n, n, h, ldh ) ) {
return -8;
}
if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
if( LAPACKE_zge_nancheck( matrix_order, n, n, q, ldq ) ) {
return -14;
}
}
if( LAPACKE_zge_nancheck( matrix_order, n, n, t, ldt ) ) {
return -10;
}
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
if( LAPACKE_zge_nancheck( matrix_order, n, n, z, ldz ) ) {
return -16;
}
}
#endif
/* Allocate memory for working array(s) */
rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
if( rwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Query optimal working array(s) size */
info = LAPACKE_zhgeqz_work( matrix_order, job, compq, compz, n, ilo, ihi, h,
ldh, t, ldt, alpha, beta, q, ldq, z, ldz,
&work_query, lwork, rwork );
if( info != 0 ) {
goto exit_level_1;
}
lwork = LAPACK_Z2INT( work_query );
/* Allocate memory for work arrays */
work = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Call middle-level interface */
info = LAPACKE_zhgeqz_work( matrix_order, job, compq, compz, n, ilo, ihi, h,
ldh, t, ldt, alpha, beta, q, ldq, z, ldz, work,
lwork, rwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_1:
LAPACKE_free( rwork );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zhgeqz", info );
}
return info;
}
lapack_int LAPACKE_dggev3_work( int matrix_layout, char jobvl, char jobvr,
lapack_int n, double* a, lapack_int lda,
double* b, lapack_int ldb, double* alphar,
double* alphai, double* beta, double* vl,
lapack_int ldvl, double* vr, lapack_int ldvr,
double* work, lapack_int lwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_dggev3( &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_layout == 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);
double* a_t = NULL;
double* b_t = NULL;
double* vl_t = NULL;
double* vr_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_dggev3_work", info );
return info;
}
if( ldb < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_dggev3_work", info );
return info;
}
if( ldvl < ncols_vl ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_dggev3_work", info );
return info;
}
if( ldvr < ncols_vr ) {
info = -15;
LAPACKE_xerbla( "LAPACKE_dggev3_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_dggev3( &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 = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
b_t = (double*)LAPACKE_malloc( sizeof(double) * 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 = (double*)
LAPACKE_malloc( sizeof(double) * 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 = (double*)
LAPACKE_malloc( sizeof(double) * ldvr_t * MAX(1,ncols_vr) );
if( vr_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_3;
}
}
/* Transpose input matrices */
LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t );
LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_dggev3( &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_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
if( LAPACKE_lsame( jobvl, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t,
ldvl_t, vl, ldvl );
}
if( LAPACKE_lsame( jobvr, 'v' ) ) {
LAPACKE_dge_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_dggev3_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_dggev3_work", info );
}
return info;
}
lapack_int LAPACKE_sormlq_work( int matrix_order, 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;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
&lwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,k);
lapack_int ldc_t = MAX(1,m);
float* a_t = NULL;
float* c_t = NULL;
/* Check leading dimension(s) */
if( lda < m ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
return info;
}
if( ldc < n ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_sormlq( &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,m) );
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_order, k, m, a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */
LAPACK_sormlq( &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_sormlq_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
}
return info;
}
lapack_int LAPACKE_sgghrd_work( int matrix_order, char compq, char compz,
lapack_int n, lapack_int ilo, lapack_int ihi,
float* a, lapack_int lda, float* b,
lapack_int ldb, float* q, lapack_int ldq,
float* z, lapack_int ldz )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sgghrd( &compq, &compz, &n, &ilo, &ihi, a, &lda, b, &ldb, q,
&ldq, z, &ldz, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
lapack_int ldb_t = MAX(1,n);
lapack_int ldq_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
float* a_t = NULL;
float* b_t = NULL;
float* q_t = NULL;
float* z_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
return info;
}
if( ldb < n ) {
info = -10;
LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
return info;
}
if( ldq < n ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
return info;
}
if( ldz < n ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_sgghrd_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( compq, 'i' ) || LAPACKE_lsame( compq, '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_2;
}
}
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) );
if( z_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 );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_sge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
}
if( LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
}
/* Call LAPACK function and adjust info */
LAPACK_sgghrd( &compq, &compz, &n, &ilo, &ihi, a_t, &lda_t, b_t, &ldb_t,
q_t, &ldq_t, z_t, &ldz_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 );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
}
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
}
/* Release memory and exit */
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_free( z_t );
}
exit_level_3:
if( LAPACKE_lsame( compq, 'i' ) || LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_free( q_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_sgghrd_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sgghrd_work", info );
}
return info;
}
lapack_int LAPACKE_strevc_work( int matrix_order, char side, char howmny,
lapack_logical* select, lapack_int n,
const float* t, lapack_int ldt, float* vl,
lapack_int ldvl, float* vr, lapack_int ldvr,
lapack_int mm, lapack_int* m, float* work )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_strevc( &side, &howmny, select, &n, t, &ldt, vl, &ldvl, vr,
&ldvr, &mm, m, work, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldt_t = MAX(1,n);
lapack_int ldvl_t = MAX(1,n);
lapack_int ldvr_t = MAX(1,n);
float* t_t = NULL;
float* vl_t = NULL;
float* vr_t = NULL;
/* Check leading dimension(s) */
if( ldt < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_strevc_work", info );
return info;
}
if( ldvl < mm ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_strevc_work", info );
return info;
}
if( ldvr < mm ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_strevc_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,n) );
if( t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
vl_t = (float*)LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,mm) );
if( vl_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
}
if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
vr_t = (float*)LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,mm) );
if( vr_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
if( ( LAPACKE_lsame( side, 'l' ) || LAPACKE_lsame( side, 'b' ) ) &&
LAPACKE_lsame( howmny, 'b' ) ) {
LAPACKE_sge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
}
if( ( LAPACKE_lsame( side, 'r' ) || LAPACKE_lsame( side, 'b' ) ) &&
LAPACKE_lsame( howmny, 'b' ) ) {
LAPACKE_sge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
}
/* Call LAPACK function and adjust info */
LAPACK_strevc( &side, &howmny, select, &n, t_t, &ldt_t, vl_t, &ldvl_t,
vr_t, &ldvr_t, &mm, m, work, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl,
ldvl );
}
if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr,
ldvr );
}
/* Release memory and exit */
if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'r' ) ) {
LAPACKE_free( vr_t );
}
exit_level_2:
if( LAPACKE_lsame( side, 'b' ) || LAPACKE_lsame( side, 'l' ) ) {
LAPACKE_free( vl_t );
}
exit_level_1:
LAPACKE_free( t_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_strevc_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_strevc_work", info );
}
return info;
}
lapack_int LAPACKE_zhpevd_work( int matrix_layout, char jobz, char uplo,
lapack_int n, lapack_complex_double* ap,
double* w, lapack_complex_double* z,
lapack_int ldz, lapack_complex_double* work,
lapack_int lwork, double* rwork,
lapack_int lrwork, lapack_int* iwork,
lapack_int liwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zhpevd( &jobz, &uplo, &n, ap, w, z, &ldz, work, &lwork, rwork,
&lrwork, iwork, &liwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldz_t = MAX(1,n);
lapack_complex_double* z_t = NULL;
lapack_complex_double* ap_t = NULL;
/* Check leading dimension(s) */
if( ldz < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_zhpevd_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( liwork == -1 || lrwork == -1 || lwork == -1 ) {
LAPACK_zhpevd( &jobz, &uplo, &n, ap, w, z, &ldz_t, work, &lwork,
rwork, &lrwork, iwork, &liwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( jobz, 'v' ) ) {
z_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldz_t * MAX(1,n) );
if( z_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
}
ap_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
( 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_zhp_trans( matrix_layout, uplo, n, ap, ap_t );
/* Call LAPACK function and adjust info */
LAPACK_zhpevd( &jobz, &uplo, &n, ap_t, w, z_t, &ldz_t, work, &lwork,
rwork, &lrwork, iwork, &liwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
}
LAPACKE_zhp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap );
/* Release memory and exit */
LAPACKE_free( ap_t );
exit_level_1:
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_free( z_t );
}
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zhpevd_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zhpevd_work", info );
}
return info;
}
lapack_int LAPACKE_sgerfs_work( int matrix_order, char trans, lapack_int n,
lapack_int nrhs, const float* a, lapack_int lda,
const float* af, lapack_int ldaf,
const lapack_int* ipiv, const float* b,
lapack_int ldb, float* x, lapack_int ldx,
float* ferr, float* berr, float* work,
lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sgerfs( &trans, &n, &nrhs, a, &lda, af, &ldaf, ipiv, b, &ldb, x,
&ldx, ferr, berr, work, iwork, &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);
float* a_t = NULL;
float* af_t = NULL;
float* b_t = NULL;
float* x_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
return info;
}
if( ldaf < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
return info;
}
if( ldb < nrhs ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
return info;
}
if( ldx < nrhs ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_sgerfs_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;
}
af_t = (float*)LAPACKE_malloc( sizeof(float) * ldaf_t * MAX(1,n) );
if( af_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) );
if( x_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, af, ldaf, af_t, ldaf_t );
LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
LAPACKE_sge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
/* Call LAPACK function and adjust info */
LAPACK_sgerfs( &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, b_t,
&ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx );
/* Release memory and exit */
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_sgerfs_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_sgerfs_work", info );
}
return info;
}
lapack_int LAPACKE_cbbcsd_work( int matrix_layout, char jobu1, char jobu2,
char jobv1t, char jobv2t, char trans,
lapack_int m, lapack_int p, lapack_int q,
float* theta, float* phi,
lapack_complex_float* u1, lapack_int ldu1,
lapack_complex_float* u2, lapack_int ldu2,
lapack_complex_float* v1t, lapack_int ldv1t,
lapack_complex_float* v2t, lapack_int ldv2t,
float* b11d, float* b11e, float* b12d,
float* b12e, float* b21d, float* b21e,
float* b22d, float* b22e, float* rwork,
lapack_int lrwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
theta, phi, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, v2t,
&ldv2t, b11d, b11e, b12d, b12e, b21d, b21e, b22d, b22e,
rwork, &lrwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1);
lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1);
lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1);
lapack_int nrows_v2t = ( LAPACKE_lsame( jobv2t, 'y' ) ? m-q : 1);
lapack_int ldu1_t = MAX(1,nrows_u1);
lapack_int ldu2_t = MAX(1,nrows_u2);
lapack_int ldv1t_t = MAX(1,nrows_v1t);
lapack_int ldv2t_t = MAX(1,nrows_v2t);
lapack_complex_float* u1_t = NULL;
lapack_complex_float* u2_t = NULL;
lapack_complex_float* v1t_t = NULL;
lapack_complex_float* v2t_t = NULL;
/* Check leading dimension(s) */
if( ldu1 < p ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
return info;
}
if( ldu2 < m-p ) {
info = -15;
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
return info;
}
if( ldv1t < q ) {
info = -17;
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
return info;
}
if( ldv2t < m-q ) {
info = -19;
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lrwork == -1 ) {
LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
theta, phi, u1, &ldu1_t, u2, &ldu2_t, v1t, &ldv1t_t,
v2t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d, b21e,
b22d, b22e, rwork, &lrwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( jobu1, 'y' ) ) {
u1_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
ldu1_t * MAX(1,p) );
if( u1_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
}
if( LAPACKE_lsame( jobu2, 'y' ) ) {
u2_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
ldu2_t * MAX(1,m-p) );
if( u2_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
}
if( LAPACKE_lsame( jobv1t, 'y' ) ) {
v1t_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
ldv1t_t * MAX(1,q) );
if( v1t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
if( LAPACKE_lsame( jobv2t, 'y' ) ) {
v2t_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
ldv2t_t * MAX(1,m-q) );
if( v2t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_3;
}
}
/* Transpose input matrices */
if( LAPACKE_lsame( jobu1, 'y' ) ) {
LAPACKE_cge_trans( matrix_layout, nrows_u1, p, u1, ldu1, u1_t,
ldu1_t );
}
if( LAPACKE_lsame( jobu2, 'y' ) ) {
LAPACKE_cge_trans( matrix_layout, nrows_u2, m-p, u2, ldu2, u2_t,
ldu2_t );
}
if( LAPACKE_lsame( jobv1t, 'y' ) ) {
LAPACKE_cge_trans( matrix_layout, nrows_v1t, q, v1t, ldv1t, v1t_t,
ldv1t_t );
}
if( LAPACKE_lsame( jobv2t, 'y' ) ) {
LAPACKE_cge_trans( matrix_layout, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
ldv2t_t );
}
/* Call LAPACK function and adjust info */
LAPACK_cbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
&ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
b21e, b22d, b22e, rwork, &lrwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( jobu1, 'y' ) ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
ldu1 );
}
if( LAPACKE_lsame( jobu2, 'y' ) ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
u2, ldu2 );
}
if( LAPACKE_lsame( jobv1t, 'y' ) ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
v1t, ldv1t );
}
if( LAPACKE_lsame( jobv2t, 'y' ) ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
v2t, ldv2t );
}
/* Release memory and exit */
if( LAPACKE_lsame( jobv2t, 'y' ) ) {
LAPACKE_free( v2t_t );
}
exit_level_3:
if( LAPACKE_lsame( jobv1t, 'y' ) ) {
LAPACKE_free( v1t_t );
}
exit_level_2:
if( LAPACKE_lsame( jobu2, 'y' ) ) {
LAPACKE_free( u2_t );
}
exit_level_1:
if( LAPACKE_lsame( jobu1, 'y' ) ) {
LAPACKE_free( u1_t );
}
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_cbbcsd_work", info );
}
return info;
}
lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct,
char storev, lapack_int m, lapack_int n,
lapack_int k, const lapack_complex_float* v,
lapack_int ldv, const lapack_complex_float* t,
lapack_int ldt, lapack_complex_float* c,
lapack_int ldc )
{
lapack_int info = 0;
lapack_int ldwork;
lapack_complex_float* work = NULL;
lapack_int ncols_v, nrows_v;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_clarfb", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
( ( LAPACKE_lsame( storev, 'r' ) &&
LAPACKE_lsame( side, 'l' ) ) ? m :
( ( LAPACKE_lsame( storev, 'r' ) &&
LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
LAPACKE_lsame( side, 'l' ) ) ? m :
( ( LAPACKE_lsame( storev, 'c' ) &&
LAPACKE_lsame( side, 'r' ) ) ? n :
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
return -13;
}
if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) {
return -11;
}
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
return -9;
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
ldv ) )
return -9;
} else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
if( k > nrows_v ) {
LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
return -8;
}
if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k,
&v[(nrows_v-k)*ldv], ldv ) )
return -9;
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
return -9;
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
return -9;
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
ldv ) )
return -9;
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
if( k > ncols_v ) {
LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
return -8;
}
if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
ldv ) )
return -9;
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
return -9;
}
}
#endif
if( LAPACKE_lsame( side, 'l' ) ) {
ldwork = n;
} else if( LAPACKE_lsame( side, 'r' ) ) {
ldwork = m;
} else {
ldwork = 1;
}
/* Allocate memory for working array(s) */
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * ldwork * MAX(1,k) );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Call middle-level interface */
info = LAPACKE_clarfb_work( matrix_layout, side, trans, direct, storev, m, n,
k, v, ldv, t, ldt, c, ldc, work, ldwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_clarfb", info );
}
return info;
}
