extern "C" void
magma_ctrdtype2cbHLsym_withQ_v2(
magma_int_t n, magma_int_t nb,
magmaFloatComplex *A, magma_int_t lda,
magmaFloatComplex *V, magma_int_t ldv,
magmaFloatComplex *TAU,
magma_int_t st, magma_int_t ed,
magma_int_t sweep, magma_int_t Vblksiz,
magmaFloatComplex *work)
{
/*
WORK (workspace) float complex array, dimension NB
*/
magma_int_t ione = 1;
magma_int_t vpos, taupos;
magmaFloatComplex conjtmp;
magmaFloatComplex c_one = MAGMA_C_ONE;
magma_int_t ldx = lda-1;
magma_int_t len = ed - st + 1;
magma_int_t lem = min(ed+nb, n) - ed;
magma_int_t lem2;
if (lem > 0) {
magma_bulge_findVTAUpos(n, nb, Vblksiz, sweep-1, st-1, ldv, &vpos, &taupos);
/* apply remaining right coming from the top block */
lapackf77_clarfx("R", &lem, &len, V(vpos), TAU(taupos), A(ed+1, st), &ldx, work);
}
if (lem > 1) {
magma_bulge_findVTAUpos(n, nb, Vblksiz, sweep-1, ed, ldv, &vpos, &taupos);
/* remove the first column of the created bulge */
*V(vpos) = c_one;
//memcpy(V(vpos+1), A(ed+2, st), (lem-1)*sizeof(magmaFloatComplex));
lem2 = lem-1;
blasf77_ccopy( &lem2, A(ed+2, st), &ione, V(vpos+1), &ione );
memset(A(ed+2, st),0,(lem-1)*sizeof(magmaFloatComplex));
/* Eliminate the col at st */
lapackf77_clarfg( &lem, A(ed+1, st), V(vpos+1), &ione, TAU(taupos) );
/* apply left on A(J1:J2,st+1:ed) */
len = len-1; /* because we start at col st+1 instead of st. col st is the col that has been removed; */
conjtmp = MAGMA_C_CNJG(*TAU(taupos));
lapackf77_clarfx("L", &lem, &len, V(vpos), &conjtmp, A(ed+1, st+1), &ldx, work);
}
}
extern "C" void
magma_strdtype1cbHLsym_withQ_v2(magma_int_t n, magma_int_t nb,
float *A, magma_int_t lda,
float *V, magma_int_t ldv,
float *TAU,
magma_int_t st, magma_int_t ed,
magma_int_t sweep, magma_int_t Vblksiz,
float *work)
{
/*
WORK (workspace) float real array, dimension N
*/
magma_int_t ione = 1;
magma_int_t vpos, taupos, len, len2;
float c_one = MAGMA_S_ONE;
magma_bulge_findVTAUpos(n, nb, Vblksiz, sweep-1, st-1, ldv, &vpos, &taupos);
//printf("voici vpos %d taupos %d tpos %d blkid %d \n", vpos, taupos, tpos, blkid);
len = ed-st+1;
*V(vpos) = c_one;
len2 = len-1;
blasf77_scopy( &len2, A(st+1, st-1), &ione, V(vpos+1), &ione );
//memcpy(V(vpos+1), A(st+1, st-1), (len-1)*sizeof(float));
memset(A(st+1, st-1), 0, (len-1)*sizeof(float));
/* Eliminate the col at st-1 */
lapackf77_slarfg( &len, A(st, st-1), V(vpos+1), &ione, TAU(taupos) );
/* apply left and right on A(st:ed,st:ed)*/
magma_slarfxsym_v2(len, A(st,st), lda-1, V(vpos), TAU(taupos), work);
}
/***************************************************************************//**
* TYPE 3-BAND Lower-columnwise-Householder
***************************************************************************/
extern "C" void
magma_dsbtype3cb(magma_int_t n, magma_int_t nb,
double *A, magma_int_t lda,
double *V, magma_int_t ldv,
double *TAU,
magma_int_t st, magma_int_t ed, magma_int_t sweep,
magma_int_t Vblksiz, magma_int_t wantz,
double *work)
{
magma_int_t len;
magma_int_t vpos, taupos;
//magma_int_t blkid, tpos;
if ( wantz == 0 ) {
vpos = (sweep%2)*n + st;
taupos = (sweep%2)*n + st;
} else {
magma_bulge_findVTAUpos(n, nb, Vblksiz, sweep, st, ldv, &vpos, &taupos);
//findVTpos(n, nb, Vblksiz, sweep, st, &vpos, &taupos, &tpos, &blkid);
}
len = ed-st+1;
/* Apply left and right on A(st:ed,st:ed)*/
magma_dlarfy(len, A(st,st), lda-1, V(vpos), TAU(taupos), work);
return;
}
extern "C" void
magma_dsbtype1cb(magma_int_t n, magma_int_t nb,
double *A, magma_int_t lda,
double *V, magma_int_t ldv,
double *TAU,
magma_int_t st, magma_int_t ed, magma_int_t sweep,
magma_int_t Vblksiz, magma_int_t wantz,
double *work)
{
magma_int_t len;
magma_int_t vpos, taupos;
//magma_int_t blkid, tpos;
magma_int_t ione = 1;
double c_one = MAGMA_D_ONE;
/* find the pointer to the Vs and Ts as stored by the bulgechasing
* note that in case no eigenvector required V and T are stored
* on a vector of size n
* */
if ( wantz == 0 ) {
vpos = (sweep%2)*n + st;
taupos = (sweep%2)*n + st;
} else {
magma_bulge_findVTAUpos(n, nb, Vblksiz, sweep, st, ldv, &vpos, &taupos);
//findVTpos(n, nb, Vblksiz, sweep, st, &vpos, &taupos, &tpos, &blkid);
}
len = ed-st+1;
*(V(vpos)) = c_one;
//magma_int_t len2 = len-1;
//blasf77_dcopy( &len2, A(st+1, st-1), &ione, V(vpos+1), &ione );
memcpy( V(vpos+1), A(st+1, st-1), (len-1)*sizeof(double) );
memset( A(st+1, st-1), 0, (len-1)*sizeof(double) );
/* Eliminate the col at st-1 */
lapackf77_dlarfg( &len, A(st, st-1), V(vpos+1), &ione, TAU(taupos) );
/* Apply left and right on A(st:ed,st:ed) */
magma_dlarfy(len, A(st,st), lda-1, V(vpos), TAU(taupos), work);
}
extern "C" void
magma_strdtype3cbHLsym_withQ_v2(magma_int_t n, magma_int_t nb,
float *A, magma_int_t lda,
float *V, magma_int_t ldv,
float *TAU,
magma_int_t st, magma_int_t ed,
magma_int_t sweep, magma_int_t Vblksiz,
float *work)
{
/*
WORK (workspace) float real array, dimension N
*/
magma_int_t vpos, taupos;
magma_bulge_findVTAUpos(n, nb, Vblksiz, sweep-1, st-1, ldv, &vpos, &taupos);
magma_int_t len = ed-st+1;
/* apply left and right on A(st:ed,st:ed)*/
magma_slarfxsym_v2(len, A(st,st), lda-1, V(vpos), TAU(taupos), work);
}
extern "C" void
magma_ztrdtype1cbHLsym_withQ_v2(magma_int_t n, magma_int_t nb,
magmaDoubleComplex *A, magma_int_t lda,
magmaDoubleComplex *V, magma_int_t ldv,
magmaDoubleComplex *TAU,
magma_int_t st, magma_int_t ed,
magma_int_t sweep, magma_int_t Vblksiz,
magmaDoubleComplex *work)
{
/*
WORK (workspace) double complex array, dimension N
*/
magma_int_t ione = 1;
magma_int_t vpos, taupos, len;
magmaDoubleComplex c_one = MAGMA_Z_ONE;
magma_bulge_findVTAUpos(n, nb, Vblksiz, sweep-1, st-1, ldv, &vpos, &taupos);
//printf("voici vpos %d taupos %d tpos %d blkid %d \n", vpos, taupos, tpos, blkid);
len = ed-st+1;
*V(vpos) = c_one;
cblas_zcopy(len-1, A(st+1, st-1), ione, V(vpos+1), ione);
//memcpy(V(vpos+1), A(st+1, st-1), (len-1)*sizeof(magmaDoubleComplex));
memset(A(st+1, st-1), 0, (len-1)*sizeof(magmaDoubleComplex));
/* Eliminate the col at st-1 */
lapackf77_zlarfg( &len, A(st, st-1), V(vpos+1), &ione, TAU(taupos) );
/* apply left and right on A(st:ed,st:ed)*/
magma_zlarfxsym_v2(len, A(st,st), lda-1, V(vpos), TAU(taupos), work);
}
extern "C" void
magma_dsbtype2cb(magma_int_t n, magma_int_t nb,
double *A, magma_int_t lda,
double *V, magma_int_t ldv,
double *TAU,
magma_int_t st, magma_int_t ed, magma_int_t sweep,
magma_int_t Vblksiz, magma_int_t wantz,
double *work)
{
double ctmp;
magma_int_t J1, J2, len, lem, ldx;
magma_int_t vpos, taupos;
//magma_int_t blkid, tpos;
magma_int_t ione = 1;
const double c_one = MAGMA_D_ONE;
if ( wantz == 0 ) {
vpos = (sweep%2)*n + st;
taupos = (sweep%2)*n + st;
} else {
//findVTpos(n, nb, Vblksiz, sweep, st, &vpos, &taupos, &tpos, &blkid);
magma_bulge_findVTAUpos(n, nb, Vblksiz, sweep, st, ldv, &vpos, &taupos);
}
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 */
lapackf77_dlarfx("R", &lem, &len, V(vpos), TAU(taupos), A(J1, st), &ldx, work);
}
if ( lem > 1 ) {
if ( wantz == 0 ) {
vpos = (sweep%2)*n + J1;
taupos = (sweep%2)*n + J1;
} else {
magma_bulge_findVTAUpos(n, nb, Vblksiz, sweep, J1, ldv, &vpos, &taupos);
//findVTpos(n,nb,Vblksiz,sweep,J1, &vpos, &taupos, &tpos, &blkid);
}
/* Remove the first column of the created bulge */
*V(vpos) = c_one;
//magma_int_t lem2=lem-1;
//blasf77_dcopy( &lem2, A(ed+2, st), &ione, V(vpos+1), &ione );
memcpy(V(vpos+1), A(J1+1, st), (lem-1)*sizeof(double));
memset(A(J1+1, st), 0, (lem-1)*sizeof(double));
/* Eliminate the col at st */
lapackf77_dlarfg( &lem, A(J1, st), V(vpos+1), &ione, 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 = MAGMA_D_CONJ(*TAU(taupos));
lapackf77_dlarfx("L", &lem, &len, V(vpos), &ctmp, A(J1, st+1), &ldx, work);
}
}
