lapack_int LAPACKE_zlarfx( int matrix_layout, char side, lapack_int m,
lapack_int n, const lapack_complex_double* v,
lapack_complex_double tau, lapack_complex_double* c,
lapack_int ldc, lapack_complex_double* work )
{
lapack_int lv;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zlarfx", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */
if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
return -7;
}
if( LAPACKE_z_nancheck( 1, &tau, 1 ) ) {
return -6;
}
lv = (LAPACKE_lsame( side, 'l' ) ? m : n);
if( LAPACKE_z_nancheck( lv, v, 1 ) ) {
return -5;
}
}
#endif
return LAPACKE_zlarfx_work( matrix_layout, side, m, n, v, tau, c, ldc,
work );
}
lapack_int LAPACKE_zlarfx( int matrix_order, char side, lapack_int m,
lapack_int n, const lapack_complex_double* v,
lapack_complex_double tau, lapack_complex_double* c,
lapack_int ldc, lapack_complex_double* work )
{
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_zlarfx", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_zge_nancheck( matrix_order, m, n, c, ldc ) ) {
return -7;
}
if( LAPACKE_z_nancheck( 1, &tau, 1 ) ) {
return -6;
}
if( LAPACKE_z_nancheck( m, v, 1 ) ) {
return -5;
}
#endif
return LAPACKE_zlarfx_work( matrix_order, side, m, n, v, tau, c, ldc,
work );
}
/***************************************************************************
* TYPE 2-BAND Lower-columnwise-Householder
***************************************************************************/
void
CORE_zhbtype2cb(int N, int NB,
PLASMA_Complex64_t *A, int LDA,
PLASMA_Complex64_t *V, PLASMA_Complex64_t *TAU,
int st, int ed, int sweep, int Vblksiz, int WANTZ,
PLASMA_Complex64_t *WORK)
{
PLASMA_Complex64_t ctmp;
int J1, J2, len, lem, LDX;
int blkid, vpos, taupos, tpos;
if( WANTZ == 0 ) {
vpos = ((sweep+1)%2)*N + st;
taupos = ((sweep+1)%2)*N + st;
} else {
findVTpos(N, NB, Vblksiz, sweep, st,
&vpos, &taupos, &tpos, &blkid);
}
LDX = LDA-1;
J1 = ed+1;
J2 = min(ed+NB,N-1);
len = ed-st+1;
lem = J2-J1+1;
if( lem > 0 ) {
/* Apply remaining right commming from the top block */
LAPACKE_zlarfx_work(LAPACK_COL_MAJOR, lapack_const(PlasmaRight),
lem, len, V(vpos), *(TAU(taupos)), A(J1, st), LDX, WORK);
}
if( lem > 1 ) {
if( WANTZ == 0 ) {
vpos = ((sweep+1)%2)*N + J1;
taupos = ((sweep+1)%2)*N + J1;
} else {
findVTpos(N,NB,Vblksiz,sweep,J1, &vpos, &taupos, &tpos, &blkid);
}
/* Remove the first column of the created bulge */
*V(vpos) = 1.;
memcpy(V(vpos+1), A(J1+1, st), (lem-1)*sizeof(PLASMA_Complex64_t));
memset(A(J1+1, st), 0, (lem-1)*sizeof(PLASMA_Complex64_t));
/* Eliminate the col at st */
LAPACKE_zlarfg_work( lem, A(J1, st), V(vpos+1), 1, TAU(taupos) );
/*
* Apply left on A(J1:J2,st+1:ed)
* We decrease len because we start at col st+1 instead of st.
* col st is the col that has been revomved;
*/
len = len-1;
ctmp = conj(*TAU(taupos));
LAPACKE_zlarfx_work(LAPACK_COL_MAJOR, lapack_const(PlasmaLeft),
lem, len, V(vpos), ctmp, A(J1, st+1), LDX, WORK);
}
return;
}
