GRASS Programmer's Manual  6.5.svn(2012)-r51648
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Defines
housev.c
Go to the documentation of this file.
00001 /*  housev.c    CCMATH mathematics library source code.
00002  *
00003  *  Copyright (C)  2000   Daniel A. Atkinson    All rights reserved.
00004  *  This code may be redistributed under the terms of the GNU library
00005  *  public license (LGPL). ( See the lgpl.license file for details.)
00006  * ------------------------------------------------------------------------
00007  */
00008 #include <stdlib.h>
00009 #include "ccmath.h"
00010 void housev(double *a, double *d, double *dp, int n)
00011 {
00012     double sc, x, y, h;
00013 
00014     int i, j, k, m, e;
00015 
00016     double *qw, *qs, *pc, *p;
00017 
00018     qs = (double *)calloc(n, sizeof(double));
00019     for (j = 0, pc = a; j < n - 2; ++j, pc += n + 1) {
00020         m = n - j - 1;
00021         for (i = 1, sc = 0.; i <= m; ++i)
00022             sc += pc[i] * pc[i];
00023         if (sc > 0.) {
00024             sc = sqrt(sc);
00025             if ((x = *(pc + 1)) < 0.) {
00026                 y = x - sc;
00027                 h = 1. / sqrt(-2. * sc * y);
00028             }
00029             else {
00030                 y = x + sc;
00031                 h = 1. / sqrt(2. * sc * y);
00032                 sc = -sc;
00033             }
00034             for (i = 0, qw = pc + 1; i < m; ++i) {
00035                 qs[i] = 0.;
00036                 if (i)
00037                     qw[i] *= h;
00038                 else
00039                     qw[i] = y * h;
00040             }
00041             for (i = 0, e = j + 2, p = pc + n + 1, h = 0.; i < m;
00042                  ++i, p += e++) {
00043                 qs[i] += (y = qw[i]) * *p++;
00044                 for (k = i + 1; k < m; ++k) {
00045                     qs[i] += qw[k] * *p;
00046                     qs[k] += y * *p++;
00047                 }
00048                 h += y * qs[i];
00049             }
00050             for (i = 0; i < m; ++i) {
00051                 qs[i] -= h * qw[i];
00052                 qs[i] += qs[i];
00053             }
00054             for (i = 0, e = j + 2, p = pc + n + 1; i < m; ++i, p += e++) {
00055                 for (k = i; k < m; ++k)
00056                     *p++ -= qw[i] * qs[k] + qs[i] * qw[k];
00057             }
00058         }
00059         d[j] = *pc;
00060         dp[j] = sc;
00061     }
00062     d[j] = *pc;
00063     dp[j] = *(pc + 1);
00064     d[j + 1] = *(pc += n + 1);
00065     free(qs);
00066     for (i = 0, m = n + n, p = pc; i < m; ++i)
00067         *p-- = 0.;
00068     *pc = 1.;
00069     *(pc -= n + 1) = 1.;
00070     qw = pc - n;
00071     for (m = 2; m < n; ++m, qw -= n + 1) {
00072         for (j = 0, p = pc, *pc = 1.; j < m; ++j, p += n) {
00073             for (i = 0, qs = p, h = 0.; i < m;)
00074                 h += qw[i++] * *qs++;
00075             for (i = 0, qs = p, h += h; i < m;)
00076                 *qs++ -= h * qw[i++];
00077         }
00078         for (i = 0, p = qw + m; i < n; ++i)
00079             *(--p) = 0.;
00080         *(pc -= n + 1) = 1.;
00081     }
00082 }