void
sgeco (float **a, int n, int *ipvt, float *rcond, float *z)
/*****************************************************************************
Gaussian elimination to obtain the LU factorization and
condition number of a matrix.
******************************************************************************
Input:
a matrix[n][n] to be factored (see notes below)
n dimension of a
Output:
a matrix[n][n] factored (see notes below)
ipvt indices of pivot permutations (see notes below)
rcond reciprocal condition number (see notes below)
Workspace:
z array[n]
******************************************************************************
Notes:
This function was adapted from LINPACK FORTRAN. Because two-dimensional
arrays cannot be declared with variable dimensions in C, the matrix a
is actually a pointer to an array of pointers to floats, as declared
above and used below.
Elements of a are stored as follows:
a[0][0] a[1][0] a[2][0] ... a[n-1][0]
a[0][1] a[1][1] a[2][1] ... a[n-1][1]
a[0][2] a[1][2] a[2][2] ... a[n-1][2]
. .
. . .
. . .
. .
a[0][n-1] a[1][n-1] a[2][n-1] ... a[n-1][n-1]
Both the factored matrix a and the pivot indices ipvt are required
to solve linear systems of equations via sgesl.
Given the reciprocal of the condition number, rcond, and the float
epsilon, FLT_EPSILON, the number of significant decimal digits, nsdd,
in the solution of a linear system of equations may be estimated by:
nsdd = (int)log10(rcond/FLT_EPSILON)
******************************************************************************
Author: Dave Hale, Colorado School of Mines, 10/01/89
*****************************************************************************/
{
int info,j,k,kp1,l;
float ek,t,wk,wkm,anorm,s,sm,ynorm;
/* compute 1-norm of a */
for (j=0,anorm=0.0; j<n; j++) {
t = sasum(n,a[j],1);
anorm = (t>anorm)?t:anorm;
}
/* factor */
sgefa(a,n,ipvt,&info);
/* rcond = 1/(norm(a)*(estimate of norm(inverse(a)))).
* estimate = norm(z)/norm(y) where Az = y and A'y = e.
* A' is the transpose of A. The components of e are
* chosen to cause maximum local growth in the elements of
* w where U'w = e. The vectors are frequently rescaled
* to avoid overflow
*/
/* solve U'w = e */
ek = 1.0;
for (j=0; j<n; j++)
z[j] = 0.0;
for (k=0; k<n; k++) {
if (z[k]!=0.0) ek = (z[k]>0.0)?-ABS(ek):ABS(ek);
if (ABS(ek-z[k])>ABS(a[k][k])) {
s = ABS(a[k][k])/ABS(ek-z[k]);
sscal(n,s,z,1);
ek *= s;
}
wk = ek-z[k];
wkm = -ek-z[k];
s = ABS(wk);
sm = ABS(wkm);
if (a[k][k]==0.0) {
wk = 1.0;
wkm = 1.0;
} else {
wk = wk/a[k][k];
wkm = wkm/a[k][k];
}
kp1 = k+1;
if (kp1<n) {
for (j=kp1; j<n; j++) {
t = z[j]+wkm*a[j][k];
sm += ABS(t);
z[j] += wk*a[j][k];
s += ABS(z[j]);
}
if (s<sm) {
t = wkm-wk;
wk = wkm;
for (j=kp1; j<n; j++)
z[j] += t*a[j][k];
}
}
z[k] = wk;
}
s = 1.0/sasum(n,z,1);
sscal(n,s,z,1);
/* solve L'y = w */
for (k=n-1; k>=0; k--) {
if (k<n-1) z[k] += sdot(n-k-1,&a[k][k+1],1,&z[k+1],1);
if (ABS(z[k])>1.0) {
s = 1.0/ABS(z[k]);
sscal(n,s,z,1);
}
l = ipvt[k];
t = z[l];
z[l] = z[k];
z[k] = t;
}
s = 1.0/sasum(n,z,1);
sscal(n,s,z,1);
ynorm = 1.0;
/* solve Lv = y */
for (k=0; k<n; k++) {
l = ipvt[k];
t = z[l];
z[l] = z[k];
z[k] = t;
if (k<n-1) saxpy(n-k-1,t,&a[k][k+1],1,&z[k+1],1);
if (ABS(z[k])>1.0) {
s = 1.0/ABS(z[k]);
sscal(n,s,z,1);
ynorm *= s;
}
}
s = 1.0/sasum(n,z,1);
sscal(n,s,z,1);
ynorm *= s;
/* solve Uz = v */
for (k=n-1; k>=0; k--) {
if (ABS(z[k])>ABS(a[k][k])) {
s = ABS(a[k][k])/ABS(z[k]);
sscal(n,s,z,1);
ynorm *= s;
}
if (a[k][k]!=0.0)
z[k] /= a[k][k];
else
z[k] = 1.0;
t = -z[k];
saxpy(k,t,a[k],1,z,1);
}
/* make znorm = 1.0 */
s = 1.0/sasum(n,z,1);
sscal(n,s,z,1);
ynorm *= s;
if (anorm!=0.0)
*rcond = ynorm/anorm;
else
*rcond = 0.0;
}
main()
{
int i,n=N;
printf("isamax = %d\n",isamax(n,sx,1));
printf("isamax = %d\n",isamax(n/2,sx,2));
printf("isamax = %d\n",isamax(n,sy,1));
printf("sasum = %g\n",sasum(n,sx,1));
printf("sasum = %g\n",sasum(n/2,sx,2));
printf("sasum = %g\n",sasum(n,sy,1));
printf("snrm2 = %g\n",snrm2(n,sx,1));
printf("snrm2 = %g\n",snrm2(n/2,sx,2));
printf("snrm2 = %g\n",snrm2(n,sy,1));
printf("sdot = %g\n",sdot(n,sx,1,sy,1));
printf("sdot = %g\n",sdot(n/2,sx,2,sy,2));
printf("sdot = %g\n",sdot(n/2,sx,-2,sy,2));
printf("sdot = %g\n",sdot(n,sy,1,sy,1));
printf("sscal\n");
sscal(n,2.0,sx,1);
pvec(n,sx);
sscal(n,0.5,sx,1);
pvec(n,sx);
sscal(n/2,2.0,sx,2);
pvec(n,sx);
sscal(n/2,0.5,sx,2);
pvec(n,sx);
printf("sswap\n");
sswap(n,sx,1,sy,1);
pvec(n,sx); pvec(n,sy);
sswap(n,sy,1,sx,1);
pvec(n,sx); pvec(n,sy);
sswap(n/2,sx,1,sx+n/2,-1);
pvec(n,sx);
sswap(n/2,sx,1,sx+n/2,-1);
pvec(n,sx);
sswap(n/2,sx,2,sy,2);
pvec(n,sx); pvec(n,sy);
sswap(n/2,sx,2,sy,2);
pvec(n,sx); pvec(n,sy);
printf("saxpy\n");
saxpy(n,2.0,sx,1,sy,1);
pvec(n,sx); pvec(n,sy);
saxpy(n,-2.0,sx,1,sy,1);
pvec(n,sx); pvec(n,sy);
saxpy(n/2,2.0,sx,2,sy,2);
pvec(n,sx); pvec(n,sy);
saxpy(n/2,-2.0,sx,2,sy,2);
pvec(n,sx); pvec(n,sy);
saxpy(n/2,2.0,sx,-2,sy,1);
pvec(n,sx); pvec(n,sy);
saxpy(n/2,-2.0,sx,-2,sy,1);
pvec(n,sx); pvec(n,sy);
printf("scopy\n");
scopy(n/2,sx,2,sy,2);
pvec(n,sx); pvec(n,sy);
scopy(n/2,sx+1,2,sy+1,2);
pvec(n,sx); pvec(n,sy);
scopy(n/2,sx,2,sy,1);
pvec(n,sx); pvec(n,sy);
scopy(n/2,sx+1,-2,sy+n/2,-1);
pvec(n,sx); pvec(n,sy);
}
