#include <cmath>
#include "../gmx_blas.h"
#include "../gmx_lapack.h"

void 
F77_FUNC(dlasd8,DLASD8)(int *icompq, 
	int *k, 
	double *d__, 
     	double *z__, 
	double *vf, 
	double *vl, 
	double *difl, 
	double *difr, 
	int *lddifr, 
	double *dsigma, 
	double *work, 
	int *info)
{
    int difr_dim1, difr_offset, i__1, i__2;
    double d__2;

    int i__, j;
    double dj, rho;
    int iwk1, iwk2, iwk3;
    double temp;
    int iwk2i, iwk3i;
    double diflj, difrj, dsigj;
    double dsigjp;
    int c__1 = 1;
    int c__0 = 0;
    double one = 1.;

    /* avoid warnings on high gcc optimization levels */
    difrj = dsigjp = 0;

     --d__;
    --z__;
    --vf;
    --vl;
    --difl;
    difr_dim1 = *lddifr;
    difr_offset = 1 + difr_dim1;
    difr -= difr_offset;
    --dsigma;
    --work;

    *info = 0;

    if (*k == 1) {
	d__[1] = std::abs(z__[1]);
	difl[1] = d__[1];
	if (*icompq == 1) {
	    difl[2] = 1.;
	    difr[(difr_dim1 << 1) + 1] = 1.;
	}
	return;
    }

    iwk1 = 1;
    iwk2 = iwk1 + *k;
    iwk3 = iwk2 + *k;
    iwk2i = iwk2 - 1;
    iwk3i = iwk3 - 1;

    rho = F77_FUNC(dnrm2,DNRM2)(k, &z__[1], &c__1);
    F77_FUNC(dlascl,DLASCL)("G", &c__0, &c__0, &rho, &one, k, &c__1, &z__[1], k, info);
    rho *= rho;

    F77_FUNC(dlaset,DLASET)("A", k, &c__1, &one, &one, &work[iwk3], k);

    i__1 = *k;
    for (j = 1; j <= i__1; ++j) {
	F77_FUNC(dlasd4,DLASD4)(k, &j, &dsigma[1], &z__[1], &work[iwk1], &rho, &d__[j], &work[
		iwk2], info);

	if (*info != 0) {
	    return;
	}
	work[iwk3i + j] = work[iwk3i + j] * work[j] * work[iwk2i + j];
	difl[j] = -work[j];
	difr[j + difr_dim1] = -work[j + 1];
	i__2 = j - 1;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i + 
		    i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
		    j]);
	}
	i__2 = *k;
	for (i__ = j + 1; i__ <= i__2; ++i__) {
	    work[iwk3i + i__] = work[iwk3i + i__] * work[i__] * work[iwk2i + 
		    i__] / (dsigma[i__] - dsigma[j]) / (dsigma[i__] + dsigma[
		    j]);
	}
    }

    i__1 = *k;
    for (i__ = 1; i__ <= i__1; ++i__) {
	d__2 =  std::sqrt(std::abs(work[iwk3i + i__]));
	z__[i__] = (z__[i__] > 0) ? d__2 : -d__2;
    }

    i__1 = *k;
    for (j = 1; j <= i__1; ++j) {
	diflj = difl[j];
	dj = d__[j];
	dsigj = -dsigma[j];
	if (j < *k) {
	    difrj = -difr[j + difr_dim1];
	    dsigjp = -dsigma[j + 1];
	}
	work[j] = -z__[j] / diflj / (dsigma[j] + dj);
	i__2 = j - 1;
	for (i__ = 1; i__ <= i__2; ++i__) {
        work[i__] = z__[i__] / (dsigma[i__] + dsigj - diflj) / ( dsigma[i__] + dj);
	}
	i__2 = *k;
	for (i__ = j + 1; i__ <= i__2; ++i__) {
	    work[i__] = z__[i__] / (dsigma[i__] + dsigjp - difrj) / (dsigma[i__] + dj);
	}
	temp = F77_FUNC(dnrm2,DNRM2)(k, &work[1], &c__1);
	work[iwk2i + j] = F77_FUNC(ddot,DDOT)(k, &work[1], &c__1, &vf[1], &c__1) / temp;
	work[iwk3i + j] = F77_FUNC(ddot,DDOT)(k, &work[1], &c__1, &vl[1], &c__1) / temp;
	if (*icompq == 1) {
	    difr[j + (difr_dim1 << 1)] = temp;
	}
    }

    F77_FUNC(dcopy,DCOPY)(k, &work[iwk2], &c__1, &vf[1], &c__1);
    F77_FUNC(dcopy,DCOPY)(k, &work[iwk3], &c__1, &vl[1], &c__1);

    return;

} 
