lapack_int LAPACKE_ctprfb( int matrix_order, char side, char trans, char direct,
char storev, lapack_int m, lapack_int n,
lapack_int k, lapack_int l,
const lapack_complex_float* v, lapack_int ldv,
const lapack_complex_float* t, lapack_int ldt,
lapack_complex_float* a, lapack_int lda,
lapack_complex_float* b, lapack_int ldb,
lapack_int myldwork )
{
lapack_int info = 0;
float* mywork = NULL;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_ctprfb", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_cge_nancheck( matrix_order, k, m, a, lda ) ) {
return -14;
}
if( LAPACKE_cge_nancheck( matrix_order, m, n, b, ldb ) ) {
return -16;
}
if( LAPACKE_cge_nancheck( matrix_order, ldt, k, t, ldt ) ) {
return -12;
}
if( LAPACKE_cge_nancheck( matrix_order, ldv, k, v, ldv ) ) {
return -10;
}
#endif
/* Allocate memory for working array(s) */
mywork = (float*)
LAPACKE_malloc( sizeof(float) * MAX(1,myldwork) * MAX(1,k) );
if( mywork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Call middle-level interface */
info = LAPACKE_ctprfb_work( matrix_order, side, trans, direct, storev, m, n,
k, l, v, ldv, t, ldt, a, lda, b, ldb, mywork,
myldwork );
/* Release memory and exit */
LAPACKE_free( mywork );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_ctprfb", info );
}
return info;
}
lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct,
char storev, lapack_int m, lapack_int n,
lapack_int k, lapack_int l,
const lapack_complex_float* v, lapack_int ldv,
const lapack_complex_float* t, lapack_int ldt,
lapack_complex_float* a, lapack_int lda,
lapack_complex_float* b, lapack_int ldb )
{
lapack_int ncols_v, nrows_v;
lapack_int info = 0;
lapack_int ldwork;
lapack_int work_size;
lapack_complex_float* work = NULL;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_ctprfb", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_lsame( storev, 'C' ) ) {
ncols_v = k;
nrows_v = LAPACKE_lsame( side, 'L' ) ? m :
( LAPACKE_lsame( side, 'R' ) ? n : 0 );
} else if( LAPACKE_lsame( storev, 'R' ) ) {
ncols_v = LAPACKE_lsame( side, 'L' ) ? m :
( LAPACKE_lsame( side, 'R' ) ? n : 0 );
nrows_v = k;
} else {
ncols_v = 0;
nrows_v = 0;
}
if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) {
return -14;
}
if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) {
return -16;
}
if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) {
return -12;
}
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v, v, ldv ) ) {
return -10;
}
#endif
if (side=='l' || side=='L') {
ldwork = k;
work_size = MAX(1,ldwork) * MAX(1,n);
}
else {
ldwork = m;
work_size = MAX(1,ldwork) * MAX(1,k);
}
/* Allocate memory for working array(s) */
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * work_size );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
/* Call middle-level interface */
info = LAPACKE_ctprfb_work( matrix_layout, side, trans, direct, storev, m, n,
k, l, v, ldv, t, ldt, a, lda, b, ldb, work,
ldwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_ctprfb", info );
}
return info;
}
