lapack_int LAPACKE_zheevd_work( int matrix_order, char jobz, char uplo,
lapack_int n, lapack_complex_double* a,
lapack_int lda, double* w,
lapack_complex_double* work, lapack_int lwork,
double* rwork, lapack_int lrwork,
lapack_int* iwork, lapack_int liwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zheevd( &jobz, &uplo, &n, a, &lda, w, work, &lwork, rwork,
&lrwork, iwork, &liwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
lapack_complex_double* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_zheevd_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( liwork == -1 || lrwork == -1 || lwork == -1 ) {
LAPACK_zheevd( &jobz, &uplo, &n, a, &lda_t, w, work, &lwork, rwork,
&lrwork, iwork, &liwork, &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,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_zheevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork,
&lrwork, iwork, &liwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_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_zheevd_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zheevd_work", info );
}
return info;
}
lapack_int LAPACKE_zsteqr_work( int matrix_order, char compz, lapack_int n,
double* d, double* e, lapack_complex_double* z,
lapack_int ldz, double* work )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zsteqr( &compz, &n, d, e, z, &ldz, work, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldz_t = MAX(1,n);
lapack_complex_double* z_t = NULL;
/* Check leading dimension(s) */
if( ldz < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_zsteqr_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, '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;
}
}
/* Transpose input matrices */
if( LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_zge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t );
}
/* Call LAPACK function and adjust info */
LAPACK_zsteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_zge_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_zsteqr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zsteqr_work", info );
}
return info;
}
lapack_int LAPACKE_zungqr_work( int matrix_layout, lapack_int m, lapack_int n,
lapack_int k, lapack_complex_double* a,
lapack_int lda,
const lapack_complex_double* tau,
lapack_complex_double* work, lapack_int lwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zungqr( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,m);
lapack_complex_double* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_zungqr_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_zungqr( &m, &n, &k, a, &lda_t, tau, 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,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_zungqr( &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_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_zungqr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zungqr_work", info );
}
return info;
}
lapack_int LAPACKE_zlascl_work( int matrix_layout, char type, lapack_int kl,
lapack_int ku, double cfrom, double cto,
lapack_int m, lapack_int n, lapack_complex_double* a,
lapack_int lda )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a, &lda, &info);
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int nrows_a = LAPACKE_lsame(type, 'b') ? kl + 1 :
LAPACKE_lsame(type, 'q') ? ku + 1 :
LAPACKE_lsame(type, 'z') ? 2 * kl + ku + 1 : m;
lapack_int lda_t = MAX(1,nrows_a);
lapack_complex_double* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_zlascl_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;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_layout, nrows_a, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_zlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info);
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_a, 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_zlascl_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zlascl_work", info );
}
return info;
}
lapack_int LAPACKE_zggbak_work( int matrix_order, char job, char side,
lapack_int n, lapack_int ilo, lapack_int ihi,
const double* lscale, const double* rscale,
lapack_int m, lapack_complex_double* v,
lapack_int ldv )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v, &ldv,
&info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldv_t = MAX(1,n);
lapack_complex_double* v_t = NULL;
/* Check leading dimension(s) */
if( ldv < m ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_zggbak_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
v_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,m) );
if( v_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, n, m, v, ldv, v_t, ldv_t );
/* Call LAPACK function and adjust info */
LAPACK_zggbak( &job, &side, &n, &ilo, &ihi, lscale, rscale, &m, v_t,
&ldv_t, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_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_zggbak_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zggbak_work", info );
}
return info;
}
lapack_int LAPACKE_zpttrs_work( int matrix_order, char uplo, lapack_int n,
lapack_int nrhs, const double* d,
const lapack_complex_double* e,
lapack_complex_double* b, lapack_int ldb )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zpttrs( &uplo, &n, &nrhs, d, e, b, &ldb, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldb_t = MAX(1,n);
lapack_complex_double* b_t = NULL;
/* Check leading dimension(s) */
if( ldb < nrhs ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_zpttrs_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
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_0;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_zpttrs( &uplo, &n, &nrhs, d, e, b_t, &ldb_t, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
/* Release memory and exit */
LAPACKE_free( b_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zpttrs_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zpttrs_work", info );
}
return info;
}
lapack_int LAPACKE_zsyconv_work( int matrix_layout, char uplo, char way,
lapack_int n, lapack_complex_double* a,
lapack_int lda, const lapack_int* ipiv,
lapack_complex_double* work )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zsyconv( &uplo, &way, &n, a, &lda, ipiv, work, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,lda);
lapack_complex_double* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_zsyconv_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;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_zsyconv( &uplo, &way, &n, a_t, &lda_t, ipiv, work, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_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_zsyconv_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zsyconv_work", info );
}
return info;
}
void LAPACKE_ztf_trans( int matrix_layout, char transr, char uplo, char diag,
lapack_int n, const lapack_complex_double *in,
lapack_complex_double *out )
{
lapack_int row, col;
lapack_logical rowmaj, ntr, lower, unit;
if( in == NULL || out == NULL ) return ;
rowmaj = (matrix_layout == LAPACK_ROW_MAJOR);
ntr = LAPACKE_lsame( transr, 'n' );
lower = LAPACKE_lsame( uplo, 'l' );
unit = LAPACKE_lsame( diag, 'u' );
if( ( !rowmaj && ( matrix_layout != LAPACK_COL_MAJOR ) ) ||
( !ntr && !LAPACKE_lsame( transr, 't' ) &&
!LAPACKE_lsame( transr, 'c' ) ) ||
( !lower && !LAPACKE_lsame( uplo, 'u' ) ) ||
( !unit && !LAPACKE_lsame( diag, 'n' ) ) ) {
/* Just exit if input parameters are wrong */
return;
}
/* Determine parameters of array representing RFP */
if( ntr ) {
if( n%2 == 0 ) {
row = n + 1;
col = n / 2;
} else {
row = n;
col = (n + 1) / 2;
}
} else {
if( n%2 == 0 ) {
row = n / 2;
col = n + 1;
} else {
row = (n + 1) / 2;
col = n;
}
}
/* Perform conversion: */
if( rowmaj ) {
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, row, col, in, col, out, row );
} else {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, row, col, in, row, out, col );
}
}
lapack_int LAPACKE_zupgtr_work( int matrix_layout, char uplo, lapack_int n,
const lapack_complex_double* ap,
const lapack_complex_double* tau,
lapack_complex_double* q, lapack_int ldq,
lapack_complex_double* work )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zupgtr( &uplo, &n, ap, tau, q, &ldq, work, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldq_t = MAX(1,n);
lapack_complex_double* q_t = NULL;
lapack_complex_double* ap_t = NULL;
/* Check leading dimension(s) */
if( ldq < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_zupgtr_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
q_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldq_t * MAX(1,n) );
if( q_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_zpp_trans( matrix_layout, uplo, n, ap, ap_t );
/* Call LAPACK function and adjust info */
LAPACK_zupgtr( &uplo, &n, ap_t, tau, q_t, &ldq_t, work, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
/* Release memory and exit */
LAPACKE_free( ap_t );
exit_level_1:
LAPACKE_free( q_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zupgtr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zupgtr_work", info );
}
return info;
}
lapack_int LAPACKE_zlapmr_work( int matrix_layout, lapack_logical forwrd,
lapack_int m, lapack_int n,
lapack_complex_double* x, lapack_int ldx,
lapack_int* k )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zlapmr( &forwrd, &m, &n, x, &ldx, k );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldx_t = MAX(1,m);
lapack_complex_double* x_t = NULL;
/* Check leading dimension(s) */
if( ldx < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_zlapmr_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
x_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldx_t * MAX(1,n) );
if( x_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t );
/* Call LAPACK function and adjust info */
LAPACK_zlapmr( &forwrd, &m, &n, x_t, &ldx_t, k );
info = 0; /* LAPACK call is ok! */
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx );
/* Release memory and exit */
LAPACKE_free( x_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zlapmr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zlapmr_work", info );
}
return info;
}
lapack_int LAPACKE_ztrttf_work( int matrix_order, char transr, char uplo,
lapack_int n, const lapack_complex_double* a,
lapack_int lda, lapack_complex_double* arf )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_ztrttf( &transr, &uplo, &n, a, &lda, arf, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
lapack_complex_double* a_t = NULL;
lapack_complex_double* arf_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_ztrttf_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;
}
arf_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
( 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_zge_trans( matrix_order, n, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_ztrttf( &transr, &uplo, &n, a_t, &lda_t, arf_t, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, arf_t, arf );
/* 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_ztrttf_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_ztrttf_work", info );
}
return info;
}
lapack_int LAPACKE_zgeequ_work( int matrix_layout, lapack_int m, lapack_int n,
const lapack_complex_double* a, lapack_int lda,
double* r, double* c, double* rowcnd,
double* colcnd, double* amax )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zgeequ( &m, &n, a, &lda, r, c, rowcnd, colcnd, amax, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,m);
lapack_complex_double* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -5;
LAPACKE_xerbla( "LAPACKE_zgeequ_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;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_zgeequ( &m, &n, a_t, &lda_t, r, c, rowcnd, colcnd, 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_zgeequ_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zgeequ_work", info );
}
return info;
}
double LAPACKE_zlange_work( int matrix_layout, char norm, lapack_int m,
lapack_int n, const lapack_complex_double* a,
lapack_int lda, double* work )
{
lapack_int info = 0;
double res = 0.;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
res = LAPACK_zlange( &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);
lapack_complex_double* a_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_zlange_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;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
res = LAPACK_zlange( &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_zlange_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zlange_work", info );
}
return res;
}
int main(void)
{
/* Local scalars */
char side, side_i;
char trans, trans_i;
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int ilo, ilo_i;
lapack_int ihi, ihi_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int ldc, ldc_i;
lapack_int ldc_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
/* Declare scalars */
lapack_int r;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_complex_double *tau = NULL, *tau_i = NULL;
lapack_complex_double *c = NULL, *c_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
lapack_complex_double *c_save = NULL;
lapack_complex_double *a_r = NULL;
lapack_complex_double *c_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zunmhr( &side, &trans, &m, &n, &ilo, &ihi, &lda, &ldc,
&lwork );
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_r = r+2;
ldc_r = n+2;
side_i = side;
trans_i = trans;
m_i = m;
n_i = n;
ilo_i = ilo;
ihi_i = ihi;
lda_i = lda;
ldc_i = ldc;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*m * sizeof(lapack_complex_double) );
tau = (lapack_complex_double *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_double) );
c = (lapack_complex_double *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
work = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*m * sizeof(lapack_complex_double) );
tau_i = (lapack_complex_double *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_double) );
c_i = (lapack_complex_double *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the backup arrays */
c_save = (lapack_complex_double *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( r*(r+2) * sizeof(lapack_complex_double) );
c_r = (lapack_complex_double *)
LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*m, a );
init_tau( (m-1), tau );
init_c( ldc*n, c );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldc*n; i++ ) {
c_save[i] = c[i];
}
/* Call the LAPACK routine */
zunmhr_( &side, &trans, &m, &n, &ilo, &ihi, a, &lda, tau, c, &ldc, work,
&lwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunmhr_work( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i,
ilo_i, ihi_i, a_i, lda_i, tau_i, c_i, ldc_i,
work_i, lwork_i );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zunmhr\n" );
} else {
printf( "FAILED: column-major middle-level interface to zunmhr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunmhr( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i, ilo_i,
ihi_i, a_i, lda_i, tau_i, c_i, ldc_i );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zunmhr\n" );
} else {
printf( "FAILED: column-major high-level interface to zunmhr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, r, a_i, lda, a_r, r+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_zunmhr_work( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i,
ilo_i, ihi_i, a_r, lda_r, tau_i, c_r, ldc_r,
work_i, lwork_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zunmhr\n" );
} else {
printf( "FAILED: row-major middle-level interface to zunmhr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, r, a_i, lda, a_r, r+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_zunmhr( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i, ilo_i,
ihi_i, a_r, lda_r, tau_i, c_r, ldc_r );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zunmhr\n" );
} else {
printf( "FAILED: row-major high-level interface to zunmhr\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
if( c != NULL ) {
LAPACKE_free( c );
}
if( c_i != NULL ) {
LAPACKE_free( c_i );
}
if( c_r != NULL ) {
LAPACKE_free( c_r );
}
if( c_save != NULL ) {
LAPACKE_free( c_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
lapack_int LAPACKE_zhbgvx_work( int matrix_layout, char jobz, char range,
char uplo, lapack_int n, lapack_int ka,
lapack_int kb, lapack_complex_double* ab,
lapack_int ldab, lapack_complex_double* bb,
lapack_int ldbb, lapack_complex_double* q,
lapack_int ldq, double vl, double vu,
lapack_int il, lapack_int iu, double abstol,
lapack_int* m, double* w,
lapack_complex_double* z, lapack_int ldz,
lapack_complex_double* work, double* rwork,
lapack_int* iwork, lapack_int* ifail )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zhbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb,
q, &ldq, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz,
work, rwork, iwork, ifail, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldab_t = MAX(1,ka+1);
lapack_int ldbb_t = MAX(1,kb+1);
lapack_int ldq_t = MAX(1,n);
lapack_int ldz_t = MAX(1,n);
lapack_complex_double* ab_t = NULL;
lapack_complex_double* bb_t = NULL;
lapack_complex_double* q_t = NULL;
lapack_complex_double* z_t = NULL;
/* Check leading dimension(s) */
if( ldab < n ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info );
return info;
}
if( ldbb < n ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info );
return info;
}
if( ldq < n ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info );
return info;
}
if( ldz < n ) {
info = -22;
LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
ab_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldab_t * MAX(1,n) );
if( ab_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
bb_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldbb_t * MAX(1,n) );
if( bb_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
if( LAPACKE_lsame( jobz, 'v' ) ) {
q_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldq_t * MAX(1,n) );
if( q_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
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_3;
}
}
/* Transpose input matrices */
LAPACKE_zhb_trans( matrix_layout, uplo, n, ka, ab, ldab, ab_t, ldab_t );
LAPACKE_zhb_trans( matrix_layout, uplo, n, kb, bb, ldbb, bb_t, ldbb_t );
/* Call LAPACK function and adjust info */
LAPACK_zhbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t,
&ldbb_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w,
z_t, &ldz_t, work, rwork, iwork, ifail, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab,
ldab );
LAPACKE_zhb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb,
ldbb );
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
}
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz );
}
/* Release memory and exit */
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_free( z_t );
}
exit_level_3:
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_free( q_t );
}
exit_level_2:
LAPACKE_free( bb_t );
exit_level_1:
LAPACKE_free( ab_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zhbgvx_work", info );
}
return info;
}
int main(void)
{
/* Local scalars */
char compq, compq_i;
lapack_int n, n_i;
lapack_int ldt, ldt_i;
lapack_int ldt_r;
lapack_int ldq, ldq_i;
lapack_int ldq_r;
lapack_int ifst, ifst_i;
lapack_int ilst, ilst_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *t = NULL, *t_i = NULL;
lapack_complex_double *q = NULL, *q_i = NULL;
lapack_complex_double *t_save = NULL;
lapack_complex_double *q_save = NULL;
lapack_complex_double *t_r = NULL;
lapack_complex_double *q_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_ztrexc( &compq, &n, &ldt, &ldq, &ifst, &ilst );
ldt_r = n+2;
ldq_r = n+2;
compq_i = compq;
n_i = n;
ldt_i = ldt;
ldq_i = ldq;
ifst_i = ifst;
ilst_i = ilst;
/* Allocate memory for the LAPACK routine arrays */
t = (lapack_complex_double *)
LAPACKE_malloc( ldt*n * sizeof(lapack_complex_double) );
q = (lapack_complex_double *)
LAPACKE_malloc( ldq*n * sizeof(lapack_complex_double) );
/* Allocate memory for the C interface function arrays */
t_i = (lapack_complex_double *)
LAPACKE_malloc( ldt*n * sizeof(lapack_complex_double) );
q_i = (lapack_complex_double *)
LAPACKE_malloc( ldq*n * sizeof(lapack_complex_double) );
/* Allocate memory for the backup arrays */
t_save = (lapack_complex_double *)
LAPACKE_malloc( ldt*n * sizeof(lapack_complex_double) );
q_save = (lapack_complex_double *)
LAPACKE_malloc( ldq*n * sizeof(lapack_complex_double) );
/* Allocate memory for the row-major arrays */
t_r = (lapack_complex_double *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
q_r = (lapack_complex_double *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_t( ldt*n, t );
init_q( ldq*n, q );
/* Backup the ouptut arrays */
for( i = 0; i < ldt*n; i++ ) {
t_save[i] = t[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_save[i] = q[i];
}
/* Call the LAPACK routine */
ztrexc_( &compq, &n, t, &ldt, q, &ldq, &ifst, &ilst, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldt*n; i++ ) {
t_i[i] = t_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
info_i = LAPACKE_ztrexc_work( LAPACK_COL_MAJOR, compq_i, n_i, t_i, ldt_i,
q_i, ldq_i, ifst_i, ilst_i );
failed = compare_ztrexc( t, t_i, q, q_i, info, info_i, compq, ldq, ldt, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to ztrexc\n" );
} else {
printf( "FAILED: column-major middle-level interface to ztrexc\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldt*n; i++ ) {
t_i[i] = t_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
info_i = LAPACKE_ztrexc( LAPACK_COL_MAJOR, compq_i, n_i, t_i, ldt_i, q_i,
ldq_i, ifst_i, ilst_i );
failed = compare_ztrexc( t, t_i, q, q_i, info, info_i, compq, ldq, ldt, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to ztrexc\n" );
} else {
printf( "FAILED: column-major high-level interface to ztrexc\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldt*n; i++ ) {
t_i[i] = t_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 );
}
info_i = LAPACKE_ztrexc_work( LAPACK_ROW_MAJOR, compq_i, n_i, t_r, ldt_r,
q_r, ldq_r, ifst_i, ilst_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, t_r, n+2, t_i, ldt );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq );
}
failed = compare_ztrexc( t, t_i, q, q_i, info, info_i, compq, ldq, ldt, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to ztrexc\n" );
} else {
printf( "FAILED: row-major middle-level interface to ztrexc\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldt*n; i++ ) {
t_i[i] = t_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 );
}
info_i = LAPACKE_ztrexc( LAPACK_ROW_MAJOR, compq_i, n_i, t_r, ldt_r, q_r,
ldq_r, ifst_i, ilst_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, t_r, n+2, t_i, ldt );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq );
}
failed = compare_ztrexc( t, t_i, q, q_i, info, info_i, compq, ldq, ldt, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to ztrexc\n" );
} else {
printf( "FAILED: row-major high-level interface to ztrexc\n" );
}
/* Release memory */
if( t != NULL ) {
LAPACKE_free( t );
}
if( t_i != NULL ) {
LAPACKE_free( t_i );
}
if( t_r != NULL ) {
LAPACKE_free( t_r );
}
if( t_save != NULL ) {
LAPACKE_free( t_save );
}
if( q != NULL ) {
LAPACKE_free( q );
}
if( q_i != NULL ) {
LAPACKE_free( q_i );
}
if( q_r != NULL ) {
LAPACKE_free( q_r );
}
if( q_save != NULL ) {
LAPACKE_free( q_save );
}
return 0;
}
lapack_int LAPACKE_zlarft_work( int matrix_order, char direct, char storev,
lapack_int n, lapack_int k,
const lapack_complex_double* v, lapack_int ldv,
const lapack_complex_double* tau,
lapack_complex_double* t, lapack_int ldt )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zlarft( &direct, &storev, &n, &k, v, &ldv, tau, t, &ldt );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int nrows_v = LAPACKE_lsame( storev, 'c' ) ? n :
( LAPACKE_lsame( storev, 'r' ) ? k : 1);
lapack_int ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
( LAPACKE_lsame( storev, 'r' ) ? n : 1);
lapack_int ldt_t = MAX(1,k);
lapack_int ldv_t = MAX(1,nrows_v);
lapack_complex_double* v_t = NULL;
lapack_complex_double* t_t = NULL;
/* Check leading dimension(s) */
if( ldt < k ) {
info = -10;
LAPACKE_xerbla( "LAPACKE_zlarft_work", info );
return info;
}
if( ldv < ncols_v ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_zlarft_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
v_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldv_t * MAX(1,ncols_v) );
if( v_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
t_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldt_t * MAX(1,k) );
if( t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, nrows_v, ncols_v, v, ldv, v_t, ldv_t );
/* Call LAPACK function and adjust info */
LAPACK_zlarft( &direct, &storev, &n, &k, v_t, &ldv_t, tau, t_t,
&ldt_t );
info = 0; /* LAPACK call is ok! */
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, k, k, t_t, ldt_t, t, ldt );
/* Release memory and exit */
LAPACKE_free( t_t );
exit_level_1:
LAPACKE_free( v_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zlarft_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zlarft_work", info );
}
return info;
}
lapack_int LAPACKE_zhsein_work( int matrix_order, char job, char eigsrc,
char initv, const lapack_logical* select,
lapack_int n, const lapack_complex_double* h,
lapack_int ldh, lapack_complex_double* w,
lapack_complex_double* vl, lapack_int ldvl,
lapack_complex_double* vr, lapack_int ldvr,
lapack_int mm, lapack_int* m,
lapack_complex_double* work, double* rwork,
lapack_int* ifaill, lapack_int* ifailr )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zhsein( &job, &eigsrc, &initv, select, &n, h, &ldh, w, vl, &ldvl,
vr, &ldvr, &mm, m, work, rwork, ifaill, ifailr, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldh_t = MAX(1,n);
lapack_int ldvl_t = MAX(1,n);
lapack_int ldvr_t = MAX(1,n);
lapack_complex_double* h_t = NULL;
lapack_complex_double* vl_t = NULL;
lapack_complex_double* vr_t = NULL;
/* Check leading dimension(s) */
if( ldh < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_zhsein_work", info );
return info;
}
if( ldvl < mm ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_zhsein_work", info );
return info;
}
if( ldvr < mm ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_zhsein_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
h_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldh_t * MAX(1,n) );
if( h_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
vl_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldvl_t * MAX(1,mm) );
if( vl_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
}
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
vr_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldvr_t * MAX(1,mm) );
if( vr_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, n, n, h, ldh, h_t, ldh_t );
if( ( LAPACKE_lsame( job, 'l' ) || LAPACKE_lsame( job, 'b' ) ) &&
LAPACKE_lsame( initv, 'v' ) ) {
LAPACKE_zge_trans( matrix_order, n, mm, vl, ldvl, vl_t, ldvl_t );
}
if( ( LAPACKE_lsame( job, 'r' ) || LAPACKE_lsame( job, 'b' ) ) &&
LAPACKE_lsame( initv, 'v' ) ) {
LAPACKE_zge_trans( matrix_order, n, mm, vr, ldvr, vr_t, ldvr_t );
}
/* Call LAPACK function and adjust info */
LAPACK_zhsein( &job, &eigsrc, &initv, select, &n, h_t, &ldh_t, w, vl_t,
&ldvl_t, vr_t, &ldvr_t, &mm, m, work, rwork, ifaill,
ifailr, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_t, ldvl_t, vl,
ldvl );
}
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_t, ldvr_t, vr,
ldvr );
}
/* Release memory and exit */
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
LAPACKE_free( vr_t );
}
exit_level_2:
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
LAPACKE_free( vl_t );
}
exit_level_1:
LAPACKE_free( h_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zhsein_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zhsein_work", info );
}
return info;
}
lapack_int LAPACKE_zhegvx_work( int matrix_order, lapack_int itype, char jobz,
char range, char uplo, lapack_int n,
lapack_complex_double* a, lapack_int lda,
lapack_complex_double* b, lapack_int ldb,
double vl, double vu, lapack_int il,
lapack_int iu, double abstol, lapack_int* m,
double* w, lapack_complex_double* z,
lapack_int ldz, lapack_complex_double* work,
lapack_int lwork, double* rwork,
lapack_int* iwork, lapack_int* ifail )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zhegvx( &itype, &jobz, &range, &uplo, &n, a, &lda, b, &ldb, &vl,
&vu, &il, &iu, &abstol, m, w, z, &ldz, work, &lwork,
rwork, iwork, ifail, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == 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);
lapack_complex_double* a_t = NULL;
lapack_complex_double* b_t = NULL;
lapack_complex_double* z_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_zhegvx_work", info );
return info;
}
if( ldb < n ) {
info = -10;
LAPACKE_xerbla( "LAPACKE_zhegvx_work", info );
return info;
}
if( ldz < ncols_z ) {
info = -19;
LAPACKE_xerbla( "LAPACKE_zhegvx_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_zhegvx( &itype, &jobz, &range, &uplo, &n, a, &lda_t, b,
&ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz_t,
work, &lwork, rwork, iwork, ifail, &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,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
b_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * 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 = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldz_t * MAX(1,ncols_z) );
if( z_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
}
}
/* Transpose input matrices */
LAPACKE_zhe_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
LAPACKE_zge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_zhegvx( &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, rwork, iwork, ifail, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
if( LAPACKE_lsame( jobz, 'v' ) ) {
LAPACKE_zge_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_zhegvx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zhegvx_work", info );
}
return info;
}
lapack_int LAPACKE_zggglm_work( int matrix_layout, lapack_int n, lapack_int m,
lapack_int p, lapack_complex_double* a,
lapack_int lda, lapack_complex_double* b,
lapack_int ldb, lapack_complex_double* d,
lapack_complex_double* x,
lapack_complex_double* y,
lapack_complex_double* work, lapack_int lwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zggglm( &n, &m, &p, a, &lda, b, &ldb, d, x, y, work, &lwork,
&info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
lapack_int ldb_t = MAX(1,n);
lapack_complex_double* a_t = NULL;
lapack_complex_double* b_t = NULL;
/* Check leading dimension(s) */
if( lda < m ) {
info = -6;
LAPACKE_xerbla( "LAPACKE_zggglm_work", info );
return info;
}
if( ldb < p ) {
info = -8;
LAPACKE_xerbla( "LAPACKE_zggglm_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_zggglm( &n, &m, &p, a, &lda_t, b, &ldb_t, d, x, y, 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,m) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
b_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,p) );
if( b_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_layout, n, m, a, lda, a_t, lda_t );
LAPACKE_zge_trans( matrix_layout, n, p, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_zggglm( &n, &m, &p, a_t, &lda_t, b_t, &ldb_t, d, x, y, work,
&lwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, m, a_t, lda_t, a, lda );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, p, 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_zggglm_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zggglm_work", info );
}
return info;
}
lapack_int LAPACKE_zunmbr_work( int matrix_order, char vect, char side,
char trans, lapack_int m, lapack_int n,
lapack_int k, 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_zunmbr( &vect, &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 nq = LAPACKE_lsame( side, 'l' ) ? m : n;
lapack_int r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
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 < MIN(nq,k) ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_zunmbr_work", info );
return info;
}
if( ldc < n ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_zunmbr_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_zunmbr( &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 = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
lda_t * MAX(1,MIN(nq,k)) );
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, MIN(nq,k), 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_zunmbr( &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_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_zunmbr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zunmbr_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 */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_int *ipiv = NULL, *ipiv_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
lapack_complex_double *a_save = NULL;
lapack_int *ipiv_save = NULL;
lapack_complex_double *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zhetrf( &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 = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the backup arrays */
a_save = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
ipiv_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*n, a );
init_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 */
zhetrf_( &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_zhetrf_work( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i,
ipiv_i, work_i, lwork_i );
failed = compare_zhetrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zhetrf\n" );
} else {
printf( "FAILED: column-major middle-level interface to zhetrf\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_zhetrf( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i,
ipiv_i );
failed = compare_zhetrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zhetrf\n" );
} else {
printf( "FAILED: column-major high-level interface to zhetrf\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_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zhetrf_work( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r,
ipiv_i, work_i, lwork_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_zhetrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zhetrf\n" );
} else {
printf( "FAILED: row-major middle-level interface to zhetrf\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_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zhetrf( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r,
ipiv_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_zhetrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zhetrf\n" );
} else {
printf( "FAILED: row-major high-level interface to zhetrf\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_zupmtr_work( int matrix_layout, char side, char uplo,
char trans, lapack_int m, lapack_int n,
const lapack_complex_double* ap,
const lapack_complex_double* tau,
lapack_complex_double* c, lapack_int ldc,
lapack_complex_double* work )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zupmtr( &side, &uplo, &trans, &m, &n, ap, tau, c, &ldc, work,
&info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
lapack_int ldc_t = MAX(1,m);
lapack_complex_double* c_t = NULL;
lapack_complex_double* ap_t = NULL;
/* Check leading dimension(s) */
if( ldc < n ) {
info = -10;
LAPACKE_xerbla( "LAPACKE_zupmtr_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
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_0;
}
ap_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
( MAX(1,r) * MAX(2,r+1) ) / 2 );
if( ap_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
LAPACKE_zpp_trans( matrix_layout, uplo, r, ap, ap_t );
/* Call LAPACK function and adjust info */
LAPACK_zupmtr( &side, &uplo, &trans, &m, &n, ap_t, tau, c_t, &ldc_t,
work, &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( ap_t );
exit_level_1:
LAPACKE_free( c_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zupmtr_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zupmtr_work", info );
}
return info;
}
lapack_int LAPACKE_zggsvd_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,
lapack_complex_double* a, lapack_int lda,
lapack_complex_double* b, lapack_int ldb,
double* alpha, double* beta,
lapack_complex_double* u, lapack_int ldu,
lapack_complex_double* v, lapack_int ldv,
lapack_complex_double* q, lapack_int ldq,
lapack_complex_double* work, double* rwork,
lapack_int* iwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zggsvd( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda, b, &ldb,
alpha, beta, u, &ldu, v, &ldv, q, &ldq, work, rwork,
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);
lapack_complex_double* a_t = NULL;
lapack_complex_double* b_t = NULL;
lapack_complex_double* u_t = NULL;
lapack_complex_double* v_t = NULL;
lapack_complex_double* q_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_zggsvd_work", info );
return info;
}
if( ldb < n ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_zggsvd_work", info );
return info;
}
if( ldq < n ) {
info = -21;
LAPACKE_xerbla( "LAPACKE_zggsvd_work", info );
return info;
}
if( ldu < m ) {
info = -17;
LAPACKE_xerbla( "LAPACKE_zggsvd_work", info );
return info;
}
if( ldv < p ) {
info = -19;
LAPACKE_xerbla( "LAPACKE_zggsvd_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;
}
b_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * 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 = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
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 = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
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 = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldq_t * MAX(1,n) );
if( q_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_4;
}
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
LAPACKE_zge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_zggsvd( &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, rwork, iwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb );
if( LAPACKE_lsame( jobu, 'u' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu );
}
if( LAPACKE_lsame( jobv, 'v' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv );
}
if( LAPACKE_lsame( jobq, 'q' ) ) {
LAPACKE_zge_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_zggsvd_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zggsvd_work", info );
}
return info;
}
lapack_int LAPACKE_zposvx_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,
char* equed, double* s,
lapack_complex_double* b, lapack_int ldb,
lapack_complex_double* x, lapack_int ldx,
double* rcond, double* ferr, double* berr,
lapack_complex_double* work, double* rwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zposvx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, equed, s, b,
&ldb, x, &ldx, rcond, ferr, berr, 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;
/* Check leading dimension(s) */
if( lda < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_zposvx_work", info );
return info;
}
if( ldaf < n ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_zposvx_work", info );
return info;
}
if( ldb < nrhs ) {
info = -13;
LAPACKE_xerbla( "LAPACKE_zposvx_work", info );
return info;
}
if( ldx < nrhs ) {
info = -15;
LAPACKE_xerbla( "LAPACKE_zposvx_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;
}
/* Transpose input matrices */
LAPACKE_zpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t );
if( LAPACKE_lsame( fact, 'f' ) ) {
LAPACKE_zpo_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_zposvx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t,
equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr,
work, rwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) {
LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
}
if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
LAPACKE_zpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af,
ldaf );
}
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 );
/* 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_zposvx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zposvx_work", info );
}
return info;
}
lapack_int LAPACKE_ztrexc_work( int matrix_order, char compq, lapack_int n,
lapack_complex_double* t, lapack_int ldt,
lapack_complex_double* q, lapack_int ldq,
lapack_int ifst, lapack_int ilst )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_ztrexc( &compq, &n, t, &ldt, q, &ldq, &ifst, &ilst, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int ldq_t = MAX(1,n);
lapack_int ldt_t = MAX(1,n);
lapack_complex_double* t_t = NULL;
lapack_complex_double* q_t = NULL;
/* Check leading dimension(s) */
if( ldq < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_ztrexc_work", info );
return info;
}
if( ldt < n ) {
info = -5;
LAPACKE_xerbla( "LAPACKE_ztrexc_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
t_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldt_t * MAX(1,n) );
if( t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
if( LAPACKE_lsame( compq, 'v' ) ) {
q_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldq_t * MAX(1,n) );
if( q_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, n, n, t, ldt, t_t, ldt_t );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_zge_trans( matrix_order, n, n, q, ldq, q_t, ldq_t );
}
/* Call LAPACK function and adjust info */
LAPACK_ztrexc( &compq, &n, t_t, &ldt_t, q_t, &ldq_t, &ifst, &ilst,
&info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
}
/* Release memory and exit */
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_free( q_t );
}
exit_level_1:
LAPACKE_free( t_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_ztrexc_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_ztrexc_work", info );
}
return info;
}
int main(void)
{
/* Local scalars */
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int k, k_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_complex_double *tau = NULL, *tau_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
lapack_complex_double *a_save = NULL;
lapack_complex_double *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zunglq( &m, &n, &k, &lda, &lwork );
lda_r = n+2;
m_i = m;
n_i = n;
k_i = k;
lda_i = lda;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
tau = (lapack_complex_double *)
LAPACKE_malloc( k * sizeof(lapack_complex_double) );
work = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
tau_i = (lapack_complex_double *)
LAPACKE_malloc( k * sizeof(lapack_complex_double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the backup arrays */
a_save = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*n, a );
init_tau( k, tau );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
/* Call the LAPACK routine */
zunglq_( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunglq_work( LAPACK_COL_MAJOR, m_i, n_i, k_i, a_i, lda_i,
tau_i, work_i, lwork_i );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zunglq\n" );
} else {
printf( "FAILED: column-major middle-level interface to zunglq\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunglq( LAPACK_COL_MAJOR, m_i, n_i, k_i, a_i, lda_i,
tau_i );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zunglq\n" );
} else {
printf( "FAILED: column-major high-level interface to zunglq\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zunglq_work( LAPACK_ROW_MAJOR, m_i, n_i, k_i, a_r, lda_r,
tau_i, work_i, lwork_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zunglq\n" );
} else {
printf( "FAILED: row-major middle-level interface to zunglq\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zunglq( LAPACK_ROW_MAJOR, m_i, n_i, k_i, a_r, lda_r,
tau_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zunglq\n" );
} else {
printf( "FAILED: row-major high-level interface to zunglq\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( a_save != NULL ) {
LAPACKE_free( a_save );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
lapack_int LAPACKE_zgeqrt3_work( int matrix_order, lapack_int m, lapack_int n,
lapack_complex_double* a, lapack_int lda,
lapack_complex_double* t, lapack_int ldt )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zgeqrt3( &m, &n, a, &lda, t, &ldt, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_order == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,m);
lapack_int ldt_t = MAX(1,n);
lapack_complex_double* a_t = NULL;
lapack_complex_double* t_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -5;
LAPACKE_xerbla( "LAPACKE_zgeqrt3_work", info );
return info;
}
if( ldt < n ) {
info = -7;
LAPACKE_xerbla( "LAPACKE_zgeqrt3_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;
}
t_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldt_t * MAX(1,n) );
if( t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, m, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_zgeqrt3( &m, &n, a_t, &lda_t, t_t, &ldt_t, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
/* Release memory and exit */
LAPACKE_free( t_t );
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_zgeqrt3_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zgeqrt3_work", info );
}
return info;
}
lapack_int LAPACKE_zsprfs_work( int matrix_order, char uplo, lapack_int n,
lapack_int nrhs,
const lapack_complex_double* ap,
const lapack_complex_double* afp,
const lapack_int* ipiv,
const lapack_complex_double* b, lapack_int ldb,
lapack_complex_double* x, lapack_int ldx,
double* ferr, double* berr,
lapack_complex_double* work, double* rwork )
{
lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zsprfs( &uplo, &n, &nrhs, ap, afp, ipiv, b, &ldb, x, &ldx, ferr,
berr, work, rwork, &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);
lapack_complex_double* b_t = NULL;
lapack_complex_double* x_t = NULL;
lapack_complex_double* ap_t = NULL;
lapack_complex_double* afp_t = NULL;
/* Check leading dimension(s) */
if( ldb < nrhs ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_zsprfs_work", info );
return info;
}
if( ldx < nrhs ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_zsprfs_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
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_0;
}
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_1;
}
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_2;
}
afp_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_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_zge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
LAPACKE_zge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t );
LAPACKE_zsp_trans( matrix_order, uplo, n, ap, ap_t );
LAPACKE_zsp_trans( matrix_order, uplo, n, afp, afp_t );
/* Call LAPACK function and adjust info */
LAPACK_zsprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t,
&ldx_t, ferr, berr, work, rwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_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_zsprfs_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zsprfs_work", info );
}
return info;
}
lapack_int LAPACKE_zgbsvxx_work( int matrix_order, char fact, char trans,
lapack_int n, lapack_int kl, lapack_int ku,
lapack_int nrhs, lapack_complex_double* ab,
lapack_int ldab, lapack_complex_double* afb,
lapack_int ldafb, lapack_int* ipiv,
char* equed, double* r, double* c,
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_order == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zgbsvxx( &fact, &trans, &n, &kl, &ku, &nrhs, ab, &ldab, afb,
&ldafb, ipiv, equed, r, c, 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_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);
lapack_complex_double* ab_t = NULL;
lapack_complex_double* afb_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( ldab < n ) {
info = -9;
LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info );
return info;
}
if( ldafb < n ) {
info = -11;
LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info );
return info;
}
if( ldb < nrhs ) {
info = -17;
LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info );
return info;
}
if( ldx < nrhs ) {
info = -19;
LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info );
return info;
}
/* Allocate memory for temporary array(s) */
ab_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldab_t * MAX(1,n) );
if( ab_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
afb_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
ldafb_t * MAX(1,n) );
if( afb_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_zgb_trans( matrix_order, n, n, kl, ku, ab, ldab, ab_t, ldab_t );
if( LAPACKE_lsame( fact, 'f' ) ) {
LAPACKE_zgb_trans( matrix_order, n, n, kl, kl+ku, afb, ldafb, afb_t,
ldafb_t );
}
LAPACKE_zge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_zgbsvxx( &fact, &trans, &n, &kl, &ku, &nrhs, ab_t, &ldab_t,
afb_t, &ldafb_t, ipiv, equed, r, c, 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, 'b' ) ||
LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
LAPACKE_zgb_trans( LAPACK_COL_MAJOR, n, n, kl, ku, ab_t, ldab_t, ab,
ldab );
}
if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) {
LAPACKE_zgb_trans( LAPACK_COL_MAJOR, n, n, kl, kl+ku, afb_t,
ldafb_t, afb, ldafb );
}
if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) ||
LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) {
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, nrhs );
LAPACKE_dge_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_zgbsvxx_work", info );
}
} else {
info = -1;
LAPACKE_xerbla( "LAPACKE_zgbsvxx_work", info );
}
return info;
}
