int qrisymtri(real_t **a, int n, real_t d[], real_t b[], real_t bb[],
real_t em[])
{
void rotcol(int, int, int, int, real_t **, real_t, real_t);
int j,j1,k,m,m1,count,max;
real_t bbmax,r,s,sin,t,cos,oldcos,g,p,w,tol,tol2,lambda,dk1;
tol=em[2]*em[1];
tol2=tol*tol;
count=0;
bbmax=0.0;
max=em[4];
m=n;
do {
k=m;
m1=m-1;
while (1) {
k--;
if (k <= 0) break;
if (bb[k] < tol2) {
if (bb[k] > bbmax) bbmax=bb[k];
break;
}
}
if (k == m1)
m=m1;
else {
t=d[m]-d[m1];
r=bb[m1];
if (fabs(t) < tol)
s=sqrt(r);
else {
w=2.0/t;
s=w*r/(sqrt(w*w*r+1.0)+1.0);
}
if (k == m-2) {
d[m] += s;
d[m1] -= s;
t = -s/b[m1];
r=sqrt(t*t+1.0);
cos=1.0/r;
sin=t/r;
rotcol(1,n,m1,m,a,cos,sin);
m -= 2;
} else {
count++;
if (count > max) break;
lambda=d[m]+s;
if (fabs(t) < tol) {
w=d[m1]-s;
if (fabs(w) < fabs(lambda)) lambda=w;
}
k++;
t=d[k]-lambda;
cos=1.0;
w=b[k];
p=sqrt(t*t+w*w);
j1=k;
for (j=k+1; j<=m; j++) {
oldcos=cos;
cos=t/p;
sin=w/p;
dk1=d[j]-lambda;
t *= oldcos;
d[j1]=(t+dk1)*sin*sin+lambda+t;
t=cos*dk1-sin*w*oldcos;
w=b[j];
p=sqrt(t*t+w*w);
g=b[j1]=sin*p;
bb[j1]=g*g;
rotcol(1,n,j1,j,a,cos,sin);
j1=j;
}
d[m]=cos*t+lambda;
if (t < 0.0) b[m1] = -g;
}
}
} while (m > 0);
em[3]=sqrt(bbmax);
em[5]=count;
return m;
}
int Ti_Optimization::qrisngvaldecbid(double d[], double b[], int m, int n, double **u,
double **v, double em[])
{
int n0,n1,k,k1,i,i1,count,max,rnk;
double tol,bmax,z,x,y,g,h,f,c,s,min;
tol=em[2]*em[2];
count=0;
bmax=0.0;
max=(int)em[4];
min=em[6];
rnk=n0=n;
do
{
k=n;
n1=n-1;
while (1)
{
k--;
if (k <= 0) break;
if (fabs(b[k]) >= tol)
{
if (fabs(d[k]) < tol)
{
c=0.0;
s=1.0;
for (i=k; i<=n1; i++)
{
f=s*b[i];
b[i] *= c;
i1=i+1;
if (fabs(f) < tol)
break;
g=d[i1];
d[i1]=h=sqrt(f*f+g*g);
c=g/h;
s = -f/h;
rotcol(1,m,k,i1,u,c,s);
}
break;
}
}
else
{
if (fabs(b[k]) > bmax) bmax=fabs(b[k]);
break;
}
}//end while
if (k == n1)
{
if (d[n] < 0.0)
{
d[n] = -d[n];
for (i=1; i<=n0; i++) v[i][n] = -v[i][n];
}
if (d[n] <= min) rnk--;
n=n1;
}
else
{
count++;
if (count > max) break;
k1=k+1;
z=d[n];
x=d[k1];
y=d[n1];
g = (n1 == 1) ? 0.0 : b[n1-1];
h=b[n1];
f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
g=sqrt(f*f+1.0);
f=((x-z)*(x+z)+h*(y/((f < 0.0) ? f-g : f+g)-h))/x;
c=s=1.0;
for (i=k1+1; i<=n; i++)
{
i1=i-1;
g=b[i1];
y=d[i];
h=s*g;
g *= c;
z=sqrt(f*f+h*h);
c=f/z;
s=h/z;
if (i1 != k1) b[i1-1]=z;
f=x*c+g*s;
g=g*c-x*s;
h=y*s;
y *= c;
rotcol(1,n0,i1,i,v,c,s);
d[i1]=z=sqrt(f*f+h*h);
c=f/z;
s=h/z;
f=c*g+s*y;
x=c*y-s*g;
rotcol(1,m,i1,i,u,c,s);
}
b[n1]=f;
d[n]=x;
}
} while (n > 0);
em[3]=bmax;
em[5]=count;
em[7]=rnk;
return n;
}
